COMMENT \	FOONLY F2-F3 MICRO-CODE


Recent history:

21 Mar 80 TVR	Added DMOVE, DMOVEM and ADJSP instructions.  Changed opcode of
		XMOVE to 107, as it conflicted with ADJSP.  Experimental boot
		switches in preparation for auto-loading tapes.
22 Mar 80 TVR	Fixed some typos with above.  
26 Mar 80 TVR	Added WAITS switch to modify pager to make references to user
		ACs go to user shadow memory (instead of special place pointed
		to by AC Base Register in BBN Pager).  Since the addresses
		supplied to the random instructions must be larger than 17
		to prevent references to ACs in 2901, a page was stolen from
		the EXEC address space, currently 770xxx, and that page table
		entry in the hardware is copied from entry 0 of the user page
		table in core.
		Also, for Stanford only, defined ILGIOT to reference the PAN
		interface, so that CONSZ will skip when no device is present
		and new devices can be added to that bus without microcode
		changes.
		Fixed dispatch for UUO0 to look at opcode field only.  Made
		indirect dispatch test for the stop switch, so that stop will
		stop indirection loops
		Fixed DATAO PI, to page fault properly.
27 Mar 80 TVR	Pager mods and tape hack for CCRMA were both buggy.  Fixed.
		Fixed bug in pager: PC was being over-decremented on page
		fill cycle when indirection failed in XCTR'ed instruction.
29 Mar 80 TVR	Flushed a spurious DEST-A-MEM which prevented WAITS from
		working at XCTAC+1.
02 Apr 80 TVR	Added code to trap IOT references if not Exec or IOT-User
		mode.  New macro, UIOTRP, jumps if in IOT-USER mode.
		ILGIOT still is a no-op for non-Stanford microcode for
		the moment.
		For Stanford only, the PAN interface has its micro-interrupts
		re-enabled on PI-CHECK-RQS.
		Bummed an instruction out of IOTDIS. Indirect bit is guaranteed
		zero so one can double by shifting instead of doing an add.
03 Apr 80 TVR	Fixed ADJSP.  XCT n,[PUSH x,y] failed if x was a user AC
		reference.  Added code to emulate PUSH/POP.
04 Apr 80 TVR	XCT 1,[POP x,AC] didn't have a chance of working.  It gets
		emulated as well.  Added code for KAFIX.
11 Apr 80 TVR	Changed PAN interrupt enables in PI-CHECK-RQS.  Added reset
		code and IOT dispatch for temp. Grinnell code (under STANSW).
		Looked at DIV code to try to fix divide-by-zero.  Gave up in
		disgust.  I won't touch that code with a 10 ft battle axe!
		Fixed another stupid typo in ADJSP.
22 Apr 80 TVR	Fixed two bugs in DPB (and one in LDB).  DPB sets half flag
		if it gets a page fault on the pointer reference.  The monitor
		doesn't care much, but some user programs look at the fault
		PC and flags to decide what kind of Pager and CPU they are
		running under.  The other bug was that in LDB and DPB; they
		do not handle bytes which 'wrap-around', i.e. 36-P<S.  If this
		is the case, i think the right thing is S:=P.
		Fixed bug in DMOVEM references to ACs.  One more time on ADJSP.
		Added code (MAPRST) the clear entire map (not just valid bits)
		on 'power-up' to prevent immediate mode references from going
		to non-ex memory and/or causing spurious ECC traps.
		Wrote some code for DMOVN, DMOVNM, and KIFIX.
		Re-arranged a few things to make things fix (%$%@*#& orgs).
26 Apr 80 TVR	Merged with DWP's version, which did not contain indications
		of alterations.  Unfortunately, i did not have the most recent
		CCRMA version available, so another merge will be necessary.
		Many comments added.
30 Apr 80 TVR	Attempted merge with CCRMA version.  That tape was not complete
		so only some of the code will be merged.  Enough to proceed
		with cleanup.
		Replaced most :<expression> with macro calls in order to use
		microcode memory in a more reasonable fashion.
		More comments added.
07 May 80 TVR	The assembler is a loser!  It redefines macros alright, some of
		the time.  At any rate, the macros were rewritten and all
		(shudder) of the macro calls changed.
10 May 80 TVR	Merged in the rest of the CCRMA changes.
11 May 80 TVR	Grumble, curse, moan!!!  No, the assembler isn't THAT bad.
		The REAL loser not the assembler, but the person who wrote oet
		the old version (which had a different name) onto
		SCI:<POOLE>SLOEXP.SAV and which contains various and sundry
		bugs, one of which appears to be macro re-definition and
		another being an unusable storage map.  So, everything was
		delayed a week while i tried to get around bugs which had
		already been fixed.
		Fortunately, this time it could be converted back to the
		original form with the aid of a TECO macro.
		Adjusted memory usage and it now assembles except for
		re-usage of 5300 and 5301.
12 May 80 TVR	Adjusted some of memory usage to make the silly thing assemble
		WAITS version in preparation for making larger adjustments.
		PAN interrupts are come out in the status word as low true. PAN
		interrupt code has been corrected for that.
		Fixed a rather obscure bug in SETHLF.  Because SETHLF stores
		into CRYOV, the EXEC mode shift register (what COND[USER] is
		based on) gets forced to be the current space.  Thus,
		page faults from User pages in Exec mode on certain
		instructions (like IDPB) were being processed as being Exec
		mode page faults.
13 May 80 TVR	Added .QUAD macro and put it in places jumped to by SLOOP
		which were previously controlled by :<absolute number>.
		Adjusted memory usage to make the one area using .QUAD fit.
		Fixed misfeature in experimental boot.
		LDB/DPB for bytes that wrap around just isn't right at all!
		BYTE-OVERF is condition BEFORE incrementing, not after.  So,
		i will have to rethink this one to come up with something
		that handles that case properly without slowing byte
		instructions down significantly.

Changes at CCRMA follow:

15 May 80 TVR	Fixed bug in DMOVNM.  Changed mechanism for PAN interrupts.
		The PAN microinterrupt enable is turned off when the interrupt
		for that channel is recieved and turned on by PI-CHECK-RQS
		by setting all of the microinterrupt enables for the PAN to
		the complement of PI IN PROGRESS and PI REQUEST.  This means
		that the PAN can only request interrupts whenever something
		else isn't using those channels.  This implies that any PAN
		devices must be on the end of CONSZ chains, or else they will
		steal interrupts from other, interrupt counting devices.
24 May 80 TVR	Grinnell interrupt bug fixes.  Starting putting names on
		opcodes and stuff to make it easier to use with E.
26 May 80 TVR	Fixed problem in JRST1+1 falling thru to nothingness.  A few
		more editorial changes.
07 Jul 80 TVR	Changed CONO APR, code to turn on AR INT ENB and also made
		symbols some references to APR A-MEM relating to APR.
		Fixed bugs in F2 version of overflow interrupt.
		*** Did not look at F3 code for same. ***
		More comments added.
08 Jul 80 TVR	Made attempt to fix [I]DIV by zero and no divide.
		As part of that, commented the setup part of DODIV, and added
		code to try to restore AC after finding no divide case.  I'm
		not sure the DIV case will work properly, but we'll see...
		Fixed bug in FDVR of negative number which set the flags wrong.
		It had the wrong MASK when complementing a negative dividend
		exponent.
		Many comments added to divide and KA floating point as a result
		of chasing these.  Some have (???) being i'm not sure that either
		the code and/or the comments are right.
15 Jul 80 TVR	Installed LPT device.  Microcode for LPT is still being tested.
		Fixed bug in PAN enabling, so that PI channels that are not
		turned on do not have their micro interrupts enabled.
22 Jul 80 TVR	Fixed bug in [I]DIV which clobbered PC on divide by zero.
		Sets overflow on KIFIX now.  Also, sets overflow on KAFIX, which
		should not cause any problems.
25 Jul 80 TVR	Added FIXR and FLTR.
23 Aug 80 TVR	Fixed bugs in LDB/DPB having to do with bytes which overflow
		word boundaries.
		Ran out of micro-code space and re-adjusted .USEs to recover
		some wasted space.
		More work on LPT device.
20 Sep 80 TVR	Added a new switch, MUM2.  At the moment, this only causes
		ECC logging information to go to 1776x instead of 0776x.
		Under WAITS switch, changed APR CONI, and clock interrupt
		decision, to implement special feature of SAIL's KA, which
		turns on bit 27 in APR CONI when it is NOT interrupting.
25 Sep 80 TVR	Began merge of CCRMA version with DWP version.  MUM2 became
		XUCODE.
		Tape code got moved to separate files in order to make SRCCOM
		feasible.
		New symbol TYMORG defines where absolute part of TYMNET code
		is assembled. It only need be changed in the future.

Changes at Foonly follow:


15 Aug 80 BO	Added Versatec to unused half of CTY IOT dispatch,
		device code 124.
		Removed the 16 NOP's at the very end of memory.  VC code
		is broken up to fit available space.
		Used absolute locations 5340-5437 (5340 defined as
		VCORG1) and 7733-7777 (VCORG2) defined in VC.SLO
		
25 Sep 80 TVR	Following changes were not documented but evident from source
		comparison:

		MASK[18] was added to dispatch code at 2002. Presumably, this
			done to make the interrupt bug trap work properly.
		CONSZ to DLS when no code is assembled now always skips, so
			that TENEX can tell if the DLS exists.
		New device, VID, added.  This is Gossett's new display.
		uDevice numbers for the DLS, VC are now variables.
		Code for DMA tape controller was added.
		Two new switches were added, OTP and NTP, which stand for
			Old Tape and New Tape controllers.  NTP is for
			the DMA tape controller and all others are OTP.
		Changes to CTY code and TYMNet code to account for differences
			in MAPF fields for new tape controller.
		Some adjustment of .ORG and .USE were done to make things fit.
		FDVL was fixed.  This involved making changes to A-MEM usage
			in floating divide code.
		SLOEXP was modified to truncate jump addresses to 12 bits without
			complaint.
		New switch, XUCODE, was added.  If XUCODE=1, then some I/O devices
			are assembled into the upper 4K of microcode memory.
		A new macro, .GETADR(X), constructs a 12 bit number in Q.
		Tape code is optionally moved into upper 4K of microcode memory
			if XUCODE=1.  Dispatches for tape code were moved.
		
Versions merged.  This version is designated 1.02 by fiat of TVR.

25 Sep 80 TVR	Completed merge.
		*** VC needs a new device code.  It had used the slot assigned
		historically to the LPT.
		Some other minor formatting/comment changes were made to make
		the source merge program work properly.
		There were strong differences between the two in the floating
		divide code.  Hopefully, all of the A-MEM changes made it
		across.  I have checked them by hand.

26 Sep 80 TVR	Assigned device 520 to VC (Versatec interface), and modified
		VC.SLO to accomdate that.

4 Nov 80 PG	Added new display service for FooVision (VID.SLO). This
		stuff makes use of high memory, since it is quite large. Note
		that the ,INSERT must be right after the tape code, since
		(due to kludgery) .USE[OTHER] doesn't work properly for getting
		you back to low memory (see TYMFOO). For your information:
		.USE[HIGHMEM]	gets you to high memory
		.USE[OTHER]	gets you back to low memory
		GETADR[FOO] JUMP[GOHIGH] $	jumps to high memory 10000+FOO
						(Note that this expands
						to 2 microcode words.)
		JUMP[GOMAIN] $			jumps to MAIN in low memory

21 Nov 80 - PG	Added new output instruction to TYMNET for F5 diagnostics.
		Takes the data in the effective address, using the right
		16. bits of the right half as data to go out;
		AC=1 => STB DATA, and AC=2 => STB CTRL.

Above is version 55 as received at Symbolics

16 Mar 81 Moon	Moved TYMNET code into separate file, added new file DR11
		under new switch DR11P providing packet oriented DR11C
		support.  Involves new version of SWINIT also.

19 Mar 81 Moon	Moved DLSINI macro into F2X and F2SYM files.  This is the
		macro that defines the initial line speeds and characteristics.

21 Mar 81 Moon	Removed setting of TNODIBN etc. from CFDEF since having these
		as definitions in the ROT field stimulates all sorts of bugs
		in the microassembler.  Made them ordinary symbol definitions
		separately in both the TYMNET and DR11 files.

31 Mar 81 Moon	Made XCT 3,[LDB x,[foo(xr)]] get xr from the previous context.
		Also turned off Foovision in the Symbolics version of the
		microcode, since it takes forever to assemble and we don't
		have one.

24 Apr 81 Moon	Merged Poole's recent changes:
		Fix pdl overflow to work correctly with page faults by setting
		a bit in the PC and checking for it in the main loop, rather
		than setting a bit in the APRSTS then signalling an interrupt
		which can easily get lost if there is a page fault.

		Add "WK" and "IMP1" include files.

		Make byte-pointer indirection loops interruptible.

		Don't increment counters in locations 30-32 of events having
		to do with the map.  I guess this is supposed to be an
		efficiency improvement.

28 Apr 81 Moon	Also fix typos at APRCK1 and APRCII, testing wrong bit in
		APRSTS for pdl-overflow.

1 May 81 Moon	Fix HSMAIN+1 to use correct MAPF field so that HLRZS at the
		end of a page does not sometimes get executed twice.

3 June 81 Moon	Fix bug introduced by Poole's changes for pdl overflow.
		JRST 4, in user mode loops forever because instruction
		after JRST9 was spuriously deleted.  Also added some
		comments to this bletcherous JRST microcode and removed
		an instruction that didn't do anything (JUMP[JRST4]).

(End history)
\
COMMENT \

********************************************************

	USEFUL MICROCODE WORD DEFINITIONS

********************************************************
\

F3SW = 1 - F2SW

OTP = 1 - NTP


FIXM1 = ACSEL[MA] ALU[AC] DEST[FIXMAC-MAPF-RD] MAPF[NORM-RD] CYLEN[FIXM] $
FIXML = ACSEL[MA] ALU[AC] DEST[FIXMAC-MAPF-RD] MAPF[NORM-RD] CYLEN[LONG] $
FIXM2 = ACSEL[MA] ALU[AC] DEST[FIXMAC-MAPF-WRT] MAPF[NORM-WRT] CYLEN[FIXM] $
FIXM0 = ACSEL[MA] ALU[AC] DEST[FIXMAC-MAPF-RD] MAPF[0] CYLEN[FIXM] $
.DEFINE MEMST [] [COND[-MA-AC] LBJUMP[MSMAIN] NORM ]
  ;  NOTE:  BECAUSE OF XCT MAPPED, MEMST IS SAME AS MEMSTMA
 ; .DEFINE MEMST [] [COND[-MA-AC] LBJUMP[SMAIN] NORM ]
.DEFINE MEMSTMA [] [COND[-MA-AC] LBJUMP[MSMAIN] NORM ]

DOSKIP = D[PC] ALU[D+1] DEST[MA PC] JUMP[MAIN1] NORM $
DONTSKIP = DEST[MA] SPEC[MA_PC] JUMP[MAIN1] $
DOJUMP = D[IR] DEST[MA PC] JUMP[MAIN1] NORM $
DOM1	= SPEC[MA_PC] JUMP[MAIN1] NORM $

CLRR	= ROT 22 D[MASK 22] ALU[D&AC] ACSEL[AC] DEST[AC] $
CLRL	= 	 D[MASK 22] ALU[D&AC] ACSEL[AC] DEST[AC] $

;SLFFXM - Self FIXM (?)
;Finish read fetch of read-modify-write type cycle.
;Check to make sure effective address is writable.
;Jump if AC field in IR is non-zero
.DEFINE SLFFXM[ JDST ] 
[	ACSEL[MA] ALU[AC] DEST[FIXMAC-MAPF-WRT] MAPF[NORM-WRT] CYLEN[FIXM] COND[-AC=0] JUMP[ JDST ] $
]

;;;;;;APR-A-MEM DEFINITIONS -- THERE SHOULD BE 7 MORE OF THESE !

A-MEM-ECC-DATA = 1	;Data on last ECC error -- readable by op. 750

;;;;;;;

BADLOC = JUMP[MAIN] $;NOP FOR NOWJUMP BADPC $		;FOR WORDS WE SHOULDN'T USE
;;;;;ILGIOT = NORM JUMP[2000] $

;The standard case for IOTs without devices
.REPEAT 1 - STANSW [
.DEFINE ILGIOT[ ]
[  JUMP [MAIN] ]
];.REPEAT 1 - STANSW

;At Stanford, any devices we don't know about go to the PAN interface.  It
;may have something plugged into it that will respond to that address in a
;PDP-10ish manner.
.REPEAT STANSW [
.DEFINE ILGIOT[ ]
[ COND[-USER] LBJUMP[PANIOT] NORM ]
];.REPEAT STANSW

;Jump not IOT-USER mode
.DEFINE UIOTRP[ XXX ]
[	D[PC] ROT[6 + 1] MASK[1] COND[OBUS=0] JUMP[XXX] $
];DEFINE

.DEFINE GETADR[ADR] [  ;Place the 12-bit value of ADR in Q.
 	D[CONST (77 & (ADR / 100))] ROT[6] DEST[Q] NORM $ ;High-order 6 bits
	D[CONST (ADR \ 100)] ALU[DORQ] DEST[Q] C600 ]  ;Low-order 6 bits
	 ;NOTICE that a "$" is REQUIRED after a call of GETADR.

UUOLOC = D[CONST 40] JUMP[UUO1] NORM $

   .DEFINE MUUO1 [][ D[PC] DEST[Q AR] JUMP[MUUO2] NORM $
]
   .DEFINE UAOP1 [][ D[PC] DEST[Q AR] JUMP[UAOP] NORM $ ]

SET-TEMP-USER = D[CONST 17] ROT[11] DEST[MAP-EXEC-SR] NORM $
SET-TEMP-EXEC = D[CONST 0] ROT[11] DEST[MAP-EXEC-SR] NORM $

;
; THESE OUTLANDISHLY EXPLICIT DEFINITIONS OF NOP ASSURE THAT THE
; DECODER WILL PRINT 'NOP' ONLY WHEN YOU REALLY MEAN IT.
;
NOP =    COND[0] DEST[0] CONT ALU[D]
	ACSEL[AC] NO-MA-STB NO-AR-STB ROT[0] MASK[-1] ALU-D[NONE] $

DONOP  = COND 0 DEST[ 0] ALU[D]
	 ROT[0] MASK[-1] ACSEL[AC] JUMP[MAIN] ALU-D[NONE] NORM $

DODISP	= D[MEM] DEST[IR-ALL MA AR] SPEC[PC+1-IF&] DISP[2374] CYLEN[DISP] $

;------------------------------------------------------------------------------
;
;	CPU special registers				uDevice 0
;
;------------------------------------------------------------------------------
;
; Dev  Subsel	    Read			    Write
;
;  0	 1					Address Break Register
;	 2	Data switches			Data lights
;	 4	Address and console switches	Clear latched switches (no data)
;	10	PC History (unimplemented)	Set AR,ECC enables, MAP ON, etc.
;
;  1	 1	ECC status
;	 2	MAP status			MAP (address in MA, LOCAL USER)
;	 4	(Same as 1)
;	10	(Same as 1)
;

;------------------------------------------------------------------------------
;
;	A-Mem usage					uDevice 0 & 1
;	(Note: Not all references are symbolic as yet.
;
;------------------------------------------------------------------------------
;Device 0
A-MEM-ECC-DATA = 1	;Data on last ECC error -- readable by op. 750
APRSTS = 2	;Firmware status bits for APR
APRENB = 7	;Used to save ECC,AR interrupt enables, MAP ON, etc. during map
		;trap processing
;Device 1
ECCSVP = 3	;Pointer to next place to remember ECC interrupt in microcode
		;memory

COMMENT \

*****************************************************

		REAL CODE

*****************************************************
\

INST-DISP = 2000	;Address of instruction dispatch.
NORMAL = 4001		;Assembly starts here
  .REPEAT XUCODE [
HIGHMEM = 10001		;Upper 4K of 8K u-mem.
    ]

			;**** Next macro blows up with multiply defined symbol.			;**** Note that it usually does not complain!!!
	.OPCODE[000];	UUO 0 COMES HERE (ALONG WITH UUO 1 - 7 )

	NORM JUMP[UUO0-7] $

;; Location 2001 is used elsewhere !!!

.REPEAT F3SW [
	; INDIRECTING TRAPS HERE
: 2002	ACSEL[MA] ALU[AC] DEST[FIXMAC-MAPF-RD] MAPF[1] CYLEN[FIXM] $
	D[MEM] DEST[IR-23 MA AR] DISP[2000] SPEC[PC+1-IF] CYLEN[DISP] $
;STOP SWITCH, OV, & ECC TRAPS HERE (4 & 5)
: 2004	DEST[CLR-DEV-FROM-INTR] JUMP[SOED] NORM $
: 2005	DEST[CLR-DEV-FROM-INTR] JUMP[SOED] NORM $
	; INDEXING TRAPS HERE
: 2006	ALU[IX+D] D[IR] MASK[18.] DEST[AR IR-ADR MA] DISP[2000] SPEC[PC+1-IF] CYLEN[DISP]$

	;INTERRUPTS TRAP HERE
: 2007	D[10] SDISP C600       $

.REPEAT 0 [
: 2007	JUMP[7740] $
: 7740
	D[10] MASK[18.] DEST[Q AR] C550 $
	D[CONST 21] ROT[6] ALU[D#Q] DEST[Q] C550 $
	D[CONST 30] ALU[D#Q] COND[OBUS=0] JUMP[INTOK] C550 $
	D[CONST 34] ALU[D#Q] COND[OBUS=0] JUMP[INTOK] C550 $
	D[CONST 41] ALU[D#Q] COND[OBUS=0] JUMP[INTOK] C550 $
	D[CONST 50] ALU[D#Q] COND[OBUS=0] JUMP[INTOK] C550 $
	D[CONST 56] ALU[D#Q] COND[OBUS=0] JUMP[INTOK] C550 $

	D[CONST 1] ROT[6] ALU[D#Q] DEST[Q] C550 $
	D[CONST 62] ALU[D#Q] COND[OBUS=0] JUMP[INTOK] C550 $
	D[AR] DEST[CLR-DEV-FROM-INTR] JUMP[.] C550 $
INTOK:	D[10] SDISP C600 $

] ;REPEAT 0

 ]

.REPEAT F2SW [
.REPEAT 0 [
: 2002 ;I/O INTERRUPTS TRAP HERE
	JUMP[7740] $
: 7740
	D[10] MASK[18.] DEST[Q AR] C550 $
	D[CONST 21] ROT[6] ALU[D#Q] DEST[Q] C550 $
	D[CONST 30] ALU[D#Q] COND[OBUS=0] JUMP[INTOK] C550 $
	D[CONST 34] ALU[D#Q] COND[OBUS=0] JUMP[INTOK] C550 $
	D[CONST 41] ALU[D#Q] COND[OBUS=0] JUMP[INTOK] C550 $
	D[CONST 50] ALU[D#Q] COND[OBUS=0] JUMP[INTOK] C550 $
	D[CONST 56] ALU[D#Q] COND[OBUS=0] JUMP[INTOK] C550 $

	D[CONST 1] ROT[6] ALU[D#Q] DEST[Q] C550 $
	D[CONST 62] ALU[D#Q] COND[OBUS=0] JUMP[INTOK] C550 $
	D[AR] DEST[CLR-DEV-FROM-INTR] JUMP[MAIN] C550 $
INTOK:	D[10] SDISP C600 $
];1 - DLS	9 JAN 80 BO

:2002	;I/O INTERRUPTS TRAP HERE
	D[10] SDISP C600 $
		;Just dispatch to ucode intrpt. routine for device.
: 2003 ;STOP SWITCH TRAPS HERE
	DEST[CLR-DEV-FROM-INTR] JUMP[STOPS] NORM $
: 2004	;CAN'T GET HERE FROM THERE...
	JUMP[.] $ ;HANG FOR NOW.
: 2005	;ECC ERRORS TRAP HERE
	DEST[CLR-DEV-FROM-INTR] JUMP[SECCS] NORM $
: 2006	;PC OV TRAPS HERE
;;;	DEST[CLR-DEV-FROM-INTR] JUMP[SOVRS] NORM $
	D[CONST 1] DEST[DEV-ADR] JUMP[SOVRS] NORM $
		;Start setting up to read AR enabling
: 2007 ;BOTH ECC AND OV (AT THE SAME TIME) TRAPS HERE
	DEST[CLR-DEV-FROM-INTR] JUMP[SECCS] NORM $
: 2010 ;NORMAL INDIRECT TRAPS HERE
	ACSEL[MA] ALU[AC] DEST[FIXMAC-MAPF-RD] MAPF[1] CYLEN[FIXM] $
	D[MEM] DEST[IR-23 MA AR] DISP[2374] SPEC[PC+1-IF] CYLEN[DISP] $
		;WHEN EXTEND HAPPENS, DISP[2176]? NO-- HOW WOULD WE SEE
		;EXTENDED AREA OF IX REG?
		;Changed from 2174 to 2374 to allow stop switch to stop
		;indirection loops.  TVR-Mar80
: 2012	;NORMAL INDEXING TRAPS HERE
	ALU[IX+D] D[IR] MASK[18.] DEST[AR IR-ADR MA] DISP[2024] SPEC[PC+1-IF] CYLEN[DISP]$
		;WHEN EXTEND HAPPENS, DISP[2026]
: 2014	;EXTENDED INDIRECT TRAPS HERE
; SOMETHING MAKES THIS DIFFERENT FROM 2010 -- MAYBE LOADING H.O. MA??
 JUMP[.] $	;FOR NOW ;;;ACSEL[MA] ALU[AC] DEST[FIXMAC-MAPF-RD] MAPF[1] CYLEN[FIXM] $
	D[MEM] DEST[IR-23 MA AR] DISP[2176] SPEC[PC+1-IF] CYLEN[DISP] $
: 2016	;EXTENDED INDEXING TRAPS HERE
 JUMP[.] $	;FOR NOW ;;;D[AR] ROT[6] MASK[4] DEST[AC-SEL] NORM $
	D[AR] ALU[D+AC] ACSEL[REG] DEST[IR-ADR MA AR] SPEC[PC+1-IF] DISP[2026] CYLEN[DISP] $
  ]

;UUO1 UUO2 SMAIN SMAIN1 MAIN MAIN1 MAIN2 MSMAIN MSMAIN1 MUUO MUUO2 MUUO3 MUUO4 PIMUUO MUUO44 UUOPJ MUUO5X MUUO5Y UAOP AREA216 UMOVE JSYS JSYS3 ADJSP XMOVEM1 DMOVE DMOVN KIFIX DMOVEM DMOVNM FIXR FLTR UFA DFN FSC
;------------------------------------------------------------------------------
;	User UUO Trap
;
;	Traps thru location 40 of the current space
;
;	Instruction is stored in 40 (with effective address computed and
;		index/indirection removed)
;	Instruction in location 41 is executed, in the current space.  It
;		customarily either jumps, saving the PC and flags, or halts.
;------------------------------------------------------------------------------
	.OPCODE[010]	;User UUOs 010:017
UUO1:	D[CONST 40] DEST[MA] PUSHJ[UUOPJ] NORM  $
		;Setup MA for trap area and make mask for removing index/indir.
UUO2:	D[IR] ALU[D&Q] DEST[MEMSTO] NORM $
		;Store instruction which caused trap.
	D[PC] ALU[D-1] DEST[PC] MAPF[MASTO] CYLEN[MEMSTO] $
		;Ordinary page fault if not writable.  (*** Is PC correct???)
		;Backup the PC to point at the offensive instruction
	D[CONST 41] DEST[MA] JUMP[MAIN1] NORM $
		;Execute contents of (same space) location 41, usually a JSR or
		;a HALT instruction

: 2024
SMAIN: ACSEL[MA] D[MEM] DEST[AC AR MA] SPEC[MA_PC] JUMP[MAIN1] NORM MAPF[STO] $
SMAIN1:	D[MEM] SPEC[MA_PC] DEST[AR MA] JUMP[MAIN1] CYLEN[MEMSTO] MAPF[STO] $

MAIN:	SPEC[MA_PC] DEST[MA]   DEST[CLR-DEV-FROM-INTR]
	  D[PC] ROT[9.] C600 COND[OBUS<0] JUMP[PDLTRP] $
	   ;START THE INSTR. FETCH, un-force DEV-ADR (from last intrpt.),
	   ; and jump if a PDL OV is hanging.

MAIN1:	ACSEL[MA] ALU[AC] DEST[FIXMAC-MAPF-RD] MAPF[1] JPOP[MAIN2] NORM $ 

MAIN2:	D[MEM] DEST[IR-ALL MA AR] SPEC[PC+1-IF&] DISP[2374] CYLEN[DISP] $

	.PAIR	;: 2032 ; .PAIR
MSMAIN:	ACSEL[MA] D[MEM] DEST[AC] JUMP[MAIN] CYLEN[MEMSTO] MAPF[MASTO] $
MSMAIN1:	MAPF[MASTO] JUMP[MAIN] CYLEN[MEMSTO] $

AREA202 = .	;(Not a lot left)
	.OPCODE[020];	User UUOs 020-027
	UUOLOC $
AREA204 = .
	.OPCODE[030];	User UUOs 030-037
UUOGO:	UUOLOC $

AREA206 = .

;$*$*$*$ This should go somewhere else!!!
  .OPCODE[37]  ;Set loc 2 wds. before MUUO (opcode 37 doesn't come here).
	       ;We come here (from 2000) on opcodes 0-7.
UUO0-7:	D[IR] ROT[9.] MASK[9.] COND[OBUS=0] JUMP[MUUO] C550 $;J IF 0 UUO
	UUOLOC $

	.OPCODE[040];	Monitor UUOs 040-047 (CALL,INIT,CALLI)
MUUO:	MUUO1
;The following need not be contiguous with MUUO, it is merely here for clarity.
;It may be moved to another area if necessary.	TVR-Apr80

;------------------------------------------------------------------------------
;	Monitor UUO Trap
;
;	Traps thru location 40 of the current space, typically to handle user 
;		request to the Monitor
;
;	Instruction is stored in 40 (with effective address computed and
;		index/indirection removed)
;	Instruction in Monitor 41 is executed, in the Monitor space.  It
;		should save PC and flags, and handle the user's request.
;------------------------------------------------------------------------------
MUUO2:	D[MASK 43] ROT[37] ALU[D&Q] DEST[CRYOV] NORM $
		;Clear USER
	D[CONST 40] DEST[MA] PUSHJ[UUOPJ] NORM $
		;Setup MA for trap area and make mask for removing index/indir.
;	\ /
;Common code for instruction traps
MUUO3:	D[IR] ALU[D&Q] DEST[MEMSTO] NORM $
		;Store instruction which caused trap.
	D[MA] ALU[D+1] DEST[MA] CYLEN[MEMSTO] $
		;Now, get dispatch instruction
;------------------------------------------------------------------------------
;***  CAUTION:	If write fails, micro-machine hangs at 6100.  This should be
;***		fixed when a more general page-fault mechanism is added.  The
;***		best thing would be to just halt the macro machine.
;------------------------------------------------------------------------------
MUUO4:
PIMUUO:	D[CONST 55] ROT[2] DEST[Q FIXMAC-MAPF-RD] CYLEN[FIXM] $; JSR OPCODE
		;TVR-Apr80:  I don't have the foggiest notion what that FIXMAC
		;is supposed to do here.  The FIXM is needed for memory timing,
		;but aren't we guaranteed not to be fetching from ACs here????
MUUO44:	D[MEM] ROT[11] MASK[11] ALU[D#Q] COND[OBUS=0] JUMP[MUJSR] CYLEN[C650] $
		;Jump if trap instruction is a JSR (opcode 264 = 55*4)
	ALU[Q+1] DEST[Q] SHORT $
	D[MEM] ROT[11] MASK[11] ALU[D#Q] COND[OBUS=0] JUMP[MUJSP] C550 $
		;Jump if trap instruction is a JSP (opcode 265)
	ALU[Q+1] DEST[Q] SHORT $
	D[MEM] ROT[11] MASK[11] ALU[D#Q] COND[OBUS=0] JUMP[MUJSA] C550 $
		;Jump if trap instruction is a JSA (opcode 266)
	D[CONST 42] ROT[1] DEST[Q] SHORT $; JSYS OP
	D[MEM] ROT[11] MASK[11] ALU[D#Q] COND[OBUS=0] JUMP[MUJSYS] C550 $
		;Jump if trap instruction is a JSYS (opcode 104 = 42*2)
	D[PC] ALU[D-1] DEST[PC] SHORT $
		;Any other opcode will be XCTed and the regular code will
		;resume.
;------------------------------------------------------------------------------
;***  CAUTION:  No special dispensation has been made for BLKI/BLKO.  They
;***		MUST be handled specially, as if they DON'T skip, the
;***		second trap location should be executed and should be a JSR
;***		or some other instruction which saves flags.	TVR-Apr80
;------------------------------------------------------------------------------
	D[AR] DEST[CRYOV] JUMP[MAIN2] $
		;Else restore flags and dispatch
;------------------------------------------------------------------------------
;***  CAUTION:	This probably will not work proper if reference is being made
;***		to EXEC memory and trap was from USER.  What really needs to
;***		happen here is that the instruction should be XCTRed instead,
;***		It may be sufficient to SET-TEMP-EXEC.  I haven't looked at
;***		the problem seriously.				TVR-Apr80
;------------------------------------------------------------------------------

;Construct a mask which excludes indexing and indirection.  Used by UUO trap
;routines (and currently no where else)
UUOPJ:	D[MASK 37] ROT[27] DEST[Q] POPJ NORM $

;(NO SPACE IS LEFT.  You will have plant jumps to another area to expand the
; above code!)

	.OPCODE[050];	Monitor UUOs 050-057 (OPEN,INIT,RENAME,IN,OUT)

MUUO5X:	D[IR] ROT[7] MASK[1] DEST[Q] NORM $
		;Special check for UUOs actually used by monitors we care about
	D[IR] ROT[10] MASK[1] ALU[D#Q] COND[OBUS=0] JUMP[MUUO] C550 $
		;Jump if UUO 50,51,56, OR 57
	ALU[Q] COND[OBUS=0] JUMP[MUUO5Y] CYLEN[C450] $
		;Jump if 52 OR 53 ("Reserved for DEC")
	D[IR] ROT[11] MASK[1] COND[-OBUS=0] JUMP[MUUO] C550 $
		;Jump if 55
MUUO5Y:	D[PC] DEST[Q AR] NORM JUMP[UAOP] $
		;Take illegal inst. trap.

;------------------------------------------------------------------------------
;	Illegal Instruction Trap
;
;	Traps thru Monitor 60
;
;	Instruction is stored in 60 (with effective address computed and
;		index/indirection removed)
;	Instruction in Monitor 61 is executed, in the Monitor space.  It
;		should save PC and flags, and stop the offensive process.
;------------------------------------------------------------------------------
UAOP:	D[MASK 43] ROT[37] ALU[D&Q] DEST[CRYOV] NORM $; CLR USER
	D[MASK 37] ROT[27] DEST[Q] NORM $
	D[CONST 60] DEST[MA] JUMP[MUUO3] NORM $

AREA212 = .	;$*$** Stupid interrupt code makes this unusable!

	.OPCODE[060];	Monitor UUOs 060-067
			;(SETSTS,STATO,GETSTS,STATZ,INBUF,OUTBUF,INPUT,OUTPUT)
	MUUO1 $
;;;AREA214 = .
area214 = 2142		;Sigh... Another fixed location
	.OPCODE[070];	Monitor UUOs 070-077
			;(CLOSE,RELEAS,MTAPE,UGETF,USETI,USETO,LOOKUP,ENTER)
	MUUO1 $
AREA216:

	.OPCODE[100];	UMOVE
UMOVE:	D[PC] ALU[D-1] DEST[MA PC] NORM $ ;RE-FETCH INSTR.
	FIXM1 JUMP[UMOVX] $	;WAIT FOR FETCH.

; UMOVEI, UMOVEM, UMOVES
	.REPEAT 3 [ JUMP[UMOVE] NORM $
			NOP $ 
  		]

	.OPCODE[104];	JSYS
JSYS:
.REPEAT 1 - WAITS [
	D[IR] ROT[33] MASK[11] COND[-OBUS=0] JUMP[JSYS1] C550 $; J IF NOT EX JSYS
];.REPEAT 1 - WAITS
.REPEAT WAITS [
;EX JSYS is disabled in WAITS' BBN pager.  We simulate the same.
	JUMP[JSYS1] NORM $
];.REPEAT WAITS
JSYS3:	D[PC] DEST[Q AR] JUMP[JSYS2] $; GET PC & FLAGS

	.OPCODE[105];	ADJSP
ADJSP:	D[IR] ROT[22] MASK[0] ALU[D+AC] SPEC[LEFT] DEST[Q]
			COND[OBUS<0] JUMP[ADJSP1] C550$
		;Jump if left result is negative
	D[IR] MASK[22] ALU[D+AC] DEST[AR] JUMP[ADJSP2] NORM $	;Add right half
	;(Continued just before TYMNET code)

	.OPCODE[106]	;XMOVEM
	ALU[AC] ACSEL[AC+1] DEST[HI-ABS-MA MA] NORM $
	ALU[AC] DEST[MEMSTO] NORM JUMP[XMOVEM1] $
	.USE[AREA204]
XMOVEM1: ALU[0] DEST[HI-ABS-MA] NORM JUMP[MAIN] $

	.OPCODE[107]	;XMOVE
	ALU[AC] ACSEL[AC+1] DEST[HI-ABS-MA MA] NORM $
	ALU[0] DEST[HI-ABS-MA] JUMP[2401] NORM $

;Illegal instructions (?)
	.REPEAT 113 - 110 + 1
[	UAOP1 $
	NOP $
	]

 .REPEAT 1 - WK  [

;Illegal instructions (?)
	.REPEAT 117 - 114 + 1
[	UAOP1 $
	NOP $
	]
	       ]

   .REPEAT WK [
 
.OPCODE[114]

  	NORM JUMP[WKSEND] $
	NOP $

	NORM JUMP[WKRCV] $
	NOP $

	NORM JUMP[WKSTAT] $
	NOP $

	D[CONST 24] DEST[DEV-ADR] NORM PUSHJ[WKRST] $
	JUMP MAIN $
   ]


	.OPCODE[120]	;DMOVE
DMOVE:	FIXM1 $			; Fetch first word
	ACSEL[AC] D[MEM] DEST[AC] JUMP[DMOVE2] CYLEN[FIXM+1] $
		;Put it in an AC [*** Is CYLEN right? ***]
	;(Continued just before TYMNET code)

	.OPCODE[121]	;DMOVN
DMOVN:	FIXM1 $	;Fetch first word
	ACSEL[AC] D[MEM] ALU[NOTD] DEST[AC] SPEC[CRYOV]
			JUMP[DMOVN2] CYLEN[FIXM+1] $
		;Ones complement high order word.  Set result flags
	;(Continued just before TYMNET code)

	.OPCODE[122]	;KIFIX
KIFIX:	FIXM1 $	;Fetch first word
	D[CONST 33] DEST[Q] JUMP[KIFIX1] NORM $
		;Start making magic constant
	;(Continued just before TYMNET code)

;123
	UAOP1 $
	NOP $

	.OPCODE[124]	;DMOVEM
;*** Note: Like on the KI10, DMOVEM AC,AC+1 will lose.
DMOVEM:	FIXM2 $			; Make sure first word is in core
	ACSEL[AC] ALU[AC] DEST[MEMSTO] COND[-MA-AC] LBJUMP[DMOVM2] NORM $
		;Store first word.  Decide where it really goes.
	;(Continued just before TYMNET code)
	.OPCODE[125]	;DMOVNM
;*** Note: Like on the KI10, DMOVNM AC,AC+1 will lose.
DMOVNM:	FIXM2 $			; Make sure first word is in core
	ACSEL[AC] ALU[NOTAC] DEST[AR] SPEC[CRYOV] JUMP[DMVNM2] NORM $
		;Ones complement high order word, leave result in IR
	;(Continued just before TYMNET code)

	.OPCODE[126]	;FIXR
FIXR:	FIXM1 $	;Fetch first word
	D[CONST 04] ROT[24.] DEST[Q] JUMP[FIXR1] NORM $
		;Start making constant 0.5
	;(Continued just before TYMNET code)

	.OPCODE[127]	;FLTR
FLTR:	FIXM1 $	;Fetch first word
	D[MEM] DEST[AR] JUMP[FLTR1] $
		;Setup for normalize

	.OPCODE[130]	;UFA
UFA:	FIXM1 $
	D[CONST 11] DEST[DEV-ADR] JUMP[UFA1] $

	.OPCODE[131]	;DFN
DFN:	FIXM2 $
	D[MEM] MASK[27.] ALU[0-D] DEST[AR] COND[OBUS=0] LBJUMP[DFN1] C600 $

	.OPCODE[132]	;FSC
FSC:	D[MASK 27.] ALU[D&AC] ACSEL[AC] COND[OBUS=0] JUMP[FSCZAP] C550 $
	ACSEL[AC] ALU[AC] DEST[AR] JUMP[FSC1] NORM $

;IBP ILDB LDB IDPB DPB FAD FSB FMP FDV
;------------------------------------------------------------------------------
;
;	Byte Manipulation Instructions
;
;------------------------------------------------------------------------------
	.OPCODE[133]	;IBP (and ADJBP)
IBP:	FIXM2 COND[HALF] JUMP[MAIN] $
		;A no-op if we're already incremented.
	D[MEM] DEST[Q AR] COND[AC=0] LBJUMP[IBP1] NORM $
		;Get byte pointer and decide if it's an ADJBP or a IBP

	.OPCODE[134]	;ILDB
ILDB:	FIXM2 $
	D[MEM] DEST[Q AR] COND[-HALF] LBJUMP[ILDB1] NORM $

	.OPCODE[135]	;LDB
LDB:	FIXM1 $
	D[MEM] DEST[Q AR MA] COND[-MEM-IDX-IND] LBJUMP[LDB1] CYLEN[C500] $

IDPB:	.OPCODE[136]	;IDPB
	FIXM2 $
	D[MEM] DEST[Q AR] COND[-HALF] LBJUMP[IDPB1] NORM $

	.OPCODE[137]	;DPB
DPB:	FIXM1 $
	D[MEM] DEST[Q AR MA] LBJUMP[DPB1] COND[-MEM-IDX-IND] CYLEN[C500]  $

;------------------------------------------------------------------------------
;
;	Single Procession Floating Point
;
;------------------------------------------------------------------------------

;
;FAD FADL FADM FADB FADR FADRI FADRM FADRB
;
	.OPCODE[140]		;Opcodes 140-147
FAD:	FIXM1 JUMP[FAOS1] $ NOP $
	FIXM1 JUMP[FAOS2] $ NOP $
	FIXM2 JUMP[FAOS3] $ NOP $
	FIXM2 JUMP[FAOS4] $ NOP $
	FIXM1 JUMP[FAOS1] $ NOP $
	D[MA] ROT[18.] DEST[HOLD] SPEC[LEFT] JUMP[FAOS5] NORM $ NOP $
	FIXM2 JUMP[FAOS3] $ NOP $
	FIXM2 JUMP[FAOS4] $ NOP $

;
;FSB FSBL FSBM FSBB FSBR FSBRI FSBRM FSBRB
;
.DEFINE FSBMAC[X] [
	D[MEM] ALU[0-D] DEST[HOLD] JUMP[X] NORM 
]
	.OPCODE[150]		;Opcodes 150-157
FSB:	FIXM1 $ FSBMAC[FAOS1] $
	FIXM1 $ FSBMAC[FAOS2] $
	FIXM2 $ FSBMAC[FAOS3] $
	FIXM2 $ FSBMAC[FAOS4] $
	FIXM1 $ FSBMAC[FAOS1] $
	D[MA] ROT[18.] DEST[HOLD] ALU[0-D] SPEC[LEFT] JUMP[FAOS5] NORM $ NOP $
	FIXM2 $ FSBMAC[FAOS3] $
	FIXM2 $ FSBMAC[FAOS4] $

;
;FMP FMPL FMPM FMPB FMPR FMPRI FMPRM FMPRB
;
	.OPCODE[160]		;Opcodes 160-167
FMP:	FIXM1 JUMP[FMP1] $ NOP $
	FIXM1 JUMP[FMP2] $ NOP $
	FIXM2 JUMP[FMP3] $ NOP $
	FIXM2 JUMP[FMP4] $ NOP $
	FIXM1 JUMP[FMP1] $ NOP $
	D[MA] ROT[18.] DEST[HOLD] SPEC[LEFT] JUMP[FMP5] NORM $ NOP $
	FIXM2 JUMP[FMP3] $ NOP $
	FIXM2 JUMP[FMP4] $ NOP $

;FDV FDVL FDVM FDVB FDVR FDVRI FDVRM FDVRB
.DEFINE DIVMAC[X] [
	D[CONST 11] DEST[DEV-ADR] JUMP[X] NORM
]
	.OPCODE[170]		;Opcodes 170-177
FDV:	FIXM1 $ DIVMAC[FD1] $
	FIXM1 $ DIVMAC[FD2] $
	FIXM2 $ DIVMAC[FD3] $
	FIXM2 $ DIVMAC[FD4] $
	FIXM1 $ DIVMAC[FD1] $
	D[MA] ROT[18.] DEST[HOLD] SPEC[LEFT] NORM $ DIVMAC[FD1] $
	FIXM2 $ DIVMAC[FD3] $
	FIXM2 $ DIVMAC[FD4] $
;MOVE MOVE1 MOVEI MOVEM MOVES MOVS MOVSI MOVSM MOVSS MOVN MOVNI MOVNM MOVNS MOVM MOVM1 MOVMI MOVMM MOVMS MOVMS1 MOVMS3 MOVMS4 MOVMS5 MOVMS6 MOVMS2
;------------------------------------------------------------------------------
;
;	MOVE Group
;
;------------------------------------------------------------------------------

	.OPCODE[200]	;MOVE
MOVE:	FIXM1 $
		;Wait for memory, handle page faults, and fixup AC references
MOVE1:	ACSEL[AC] D[MEM] DEST[AC MA] SPEC[MA_PC] JUMP[MAIN1] CYLEN[FIXM+1] $
		;Store result of read in AC
		;Start next instruction fetch (DEST[MA] refers to SPEC[MA_PC])
		;We are referring to the AC specified by the AC field in the IR

	.OPCODE[201]	;MOVEI
MOVEI:	ACSEL[AC] D[IR] MASK[18.] DEST[AC MA] SPEC[MA_PC] JUMP[MAIN1] NORM $
		;Store effective address into AC
		;Ignore any page faults or other memory related problems.  Read
		;will be ignored (except for ECC checking)
		;Start next instruction fetch (DEST[MA] refers to SPEC[MA_PC])
		;We are referring to the AC specified by the AC field in the IR

	.OPCODE[202]	;MOVEM
MOVEM:	ACSEL[AC] ALU[AC] DEST[MEMSTO]  MEMST $
		;Start writing AC (selected by AC field in IR) into memory.
		;MEMST macro will send us to MSMAIN (if we're writing to
		;another AC) or MSMAIN1 (if it's a real memory reference)
		;to complete to store.

	.OPCODE[203]	;MOVES
MOVES:	FIXM1 COND[-AC=0] JUMP[MOVE1]  $
		;If AC field (in IR) is non-zero, we treat this as if it
		;were a MOVE instruction (a slight fudge).
		;*** Shouldn't this be a FIXM2?  Then it would do the right
		;*** thing for the clever person trying to fetch and dirty
		;*** a page.   TVR-Apr80
	D[MEM] DEST[MEMSTO] MEMST $
		;If AC field is zero, this is a no-op which writes memory.

	.OPCODE[204]	;MOVS
MOVS:	FIXM1 $
	ACSEL[AC] D[MEM] ROT[18.] DEST[AC MA] SPEC[MA_PC]
			JUMP[MAIN1] CYLEN[FIXM+1] $
		;Rotating by 18 swaps halves.  Otherwise, it's just like a MOVE

	.OPCODE[205]	;MOVSI
MOVSI:	ACSEL[AC] D[IR] ROT[18.] DEST[AC MA] SPEC[LEFT&MA_PC] JUMP[MAIN1] NORM$
		;Just like a MOVEI except it puts the result in the left half
		;of the AC.  (SPEC[LEFT] makes a mask of -1,,0)

	.OPCODE[206]	;MOVSM
MOVSM:	ALU[AC] ACSEL[AC] DEST[AR] NORM $
	D[AR] ROT[18.] DEST[MEMSTO] MEMST $
		;Swap halves and write it into memory like a MOVEM

	.OPCODE[207]	;MOVSS
MOVSS:	SLFFXM[MOVSS1] $
		;Finish read fetch of read-modify-write type cycle.
		;Check to make sure effective address is writable.
		;Jump if AC field in IR is non-zero
	D[MEM] ROT[18.] DEST[MEMSTO] MEMST $
		;Swap halves and write backing into same place in memory.

;*$*$*$ Move MOVSS1 here, a single instruction

	.OPCODE[210]	;MOVN
MOVN:	FIXM1 $
	ACSEL[AC] D[MEM] ALU[0-D] DEST[AC MA] SPEC[CRYOV&MA_PC]
			JUMP[MAIN1] CYLEN[FIXM+1] $
		;Like MOVE except it negates the number it loads.
		;Set flags.  400000,,0 will overflow.

	.OPCODE[211]	;MOVNI
MOVNI:	ACSEL[AC] D[IR] ALU[0-D] MASK[18.] DEST[AC MA] SPEC[CRYOV&MA_PC]
			JUMP[MAIN1] NORM $
		;Like MOVEI except that it load a negative number
		;Set flags.  Cannot overflow.

	.OPCODE[212]	;MOVNM
MOVNM:	ACSEL[AC] ALU[0-AC] DEST[MEMSTO] SPEC[CRYOV] MEMST $
		;Write negative of AC into memory.
		;Set flags.  400000,,0 will overflow.

	.OPCODE[213]	;MOVNS
MOVNS:	SLFFXM[MOVNS1] $
		;Complete fetch of read-modify-write
		;Jump if AC field (of IR) is non-zero, i.e. it loads an AC
	D[MEM] ALU[0-D] DEST[MEMSTO] SPEC[CRYOV] MEMST $
		;Write negative of number read back into memory.

;
; MOVM - Move Magnitude (Absolute value)
;
	.OPCODE[214]	;MOVM
MOVM:	FIXM1 $	;Complete data fetch
	ACSEL[AC] D[MEM] DEST[AC] COND[OBUS<0] LBJUMP[MOVM1] C600 $
		;Load number.
		;If negative, negate it to make it positive.
		;In either case, start fetch of next instruction
	.USE[AREA214]	;$*$*$ Random hole
	.PAIR
MOVM1:	SPEC[MA_PC] DEST[MA] JUMP[MAIN1] NORM $
		;Number is positive, leave it alone
		;Start next instruction fetch
	ACSEL[AC] ALU[0-AC] DEST[AC MA] SPEC[CRYOV&MA_PC] JUMP[MAIN1] NORM$
		;Number is negative, make it positive.
		;Start next instruction fetch

	.OPCODE[215]	;MOVMI
MOVMI:	ACSEL[AC] D[IR] MASK[18.] DEST[AC MA] SPEC[MA_PC] JUMP[MAIN1] NORM $
		;Immediate implies it's positive.  Equivalent to MOVEI

	.OPCODE[216]	;MOVMM
MOVMM:	ACSEL[AC] ALU[AC] COND[OBUS<0] JUMP[MOVNM] CYLEN[C450] $
		;If AC is negative, store its negation and set flags
		;Note:  It will set overflow if AC contains 400000,,0
	ACSEL[AC] ALU[AC] DEST[MEMSTO] SPEC[CRYOV] MEMST $
		;Otherwise, store positive form.  (Both paths take same amount
		;of time.)
		;Also, set flags.

	.OPCODE[217]	;MOVMS
MOVMS:	COND[MA-AC] JUMP[MOVMS2]
			DEST[FIXMAC-MAPF-WRT] MAPF[NORM-WRT] CYLEN[FIXM]$
		;Finish fetch of read-modify-write
		;Jump if we have to deal with two ACs
	COND[AC=0] LBJUMP[MOVMS1] NORM $
		;Split off case where we load AC as side effect
	.USE[AREA204]
	.PAIR
MOVMS1:	D[MEM] COND[OBUS<0] LBJUMP[MOVMS3] C550 $
		;AC field of IR is non-zero, AC is loaded as side effect
	D[MEM] COND[OBUS<0] LBJUMP[MOVMS4] C550 $
		;Reference is only to memory
	.PAIR
MOVMS3:	D[MEM] ACSEL[AC] SPEC[MA_PC] DEST[MA AC] JUMP[MAIN1] NORM $
		;Memory location is positive, just load AC
	D[MEM] ALU[0-D] ACSEL[AC] DEST[MEMSTO AC] SPEC[CRYOV] MEMST $
		;Load AC with negative of memory and write negative back
		;into memory.
		;Set flags.  Will overflow if memory contains 400000,,0
	.PAIR
MOVMS4:	SPEC[MA_PC] DEST[MA] JUMP[MAIN1] NORM $
		;Memory is positive.  Don't have to do anything here.
	D[MEM] ALU[0-D] DEST[MEMSTO] SPEC[CRYOV] JUMP[MSMAIN1] NORM $
		;Memory is negative.  Store negation.
		;Set flags.  Will overflow if memory contains 400000,,0
;Special cases for references to two ACs
	.PAIR
MOVMS5:	ACSEL[MA] ALU[0-AC] DEST[AC AR] SPEC[CRYOV]
			COND[AC=0] LBJUMP[MOVMS6] NORM $
		;'memory' AC is negative, negate it and put it somewhere
		;the other AC loaded from.
		;Then, decide whether to load it into another AC
	ACSEL[MA] ALU[AC] DEST[AR] COND[AC=0] LBJUMP[MOVMS6] NORM $
		;'memory' AC is positive.  Put it somewhere the other AC
		;can reference.
		;Decide whether to load it into	another AC
	.PAIR
MOVMS6:	ACSEL[AC] D[AR] DEST[AC MA] SPEC[MA_PC] JUMP[MAIN1] NORM $
		;AC field (of IR) is non-zero, load corresponding AC from
		;saved value of 'memory' AC.
		;Start next instruction fetch
	SPEC[MA_PC] DEST[MA] JUMP[MAIN1] NORM $
		;AC field (of IR) is zero, just start next instruction fetch
;	---
;MA refers to an AC.  Decide which special case we're dealing with.
MOVMS2:	ACSEL[MA] ALU[AC] COND[-OBUS<0] LBJUMP[MOVMS5] CYLEN[C500] $
		;Decide sign of 'memory' AC

;------------------------------------------------------------------------------
;
;	Integer Multiply
;
;------------------------------------------------------------------------------

	.OPCODE[220]	;IMUL
	FIXM1 $
	D[MEM] DEST[Q] JUMP[IMUL1] NORM $

	.OPCODE[221]	;IMULI
	D[IR] MASK[18.] DEST[Q] JUMP[IMUL1] NORM $

	.OPCODE[222]	;IMULM
	FIXM2 $
	D[MEM] DEST[Q] JUMP[IMUL2] NORM $

	.OPCODE[223]	;IMULB
	FIXM2 $
	D[MEM] DEST[Q] JUMP[IMUL3] NORM $

	.OPCODE[224]	;MUL
	FIXM1 $
	D[MEM] DEST[Q] JUMP[MUL1] NORM $

	.OPCODE[225]	;MULI
	D[IR] MASK[18.] DEST[Q] JUMP[MUL1] NORM $

	.OPCODE[226]	;MULM
	FIXM2 $
	D[MEM] DEST[Q] JUMP[MUL2] NORM $

	.OPCODE[227]	;MULB
	FIXM2 $
	D[MEM] DEST[Q] JUMP[MUL3] NORM $

;*$*$* Move rest of multiply code here

;------------------------------------------------------------------------------
;
;	Integer Divide
;
;------------------------------------------------------------------------------

	.OPCODE[230]	;IDIV
	FIXM1 $
IDIV9:	ACSEL[AC] ALU[AC] DEST[Q AR] COND[-OBUS<0] LBJUMP[IDIV1] CYLEN[C500] $
		;LO PART TO Q, CHECK SIGN

	.OPCODE[231]	;IDIVI
	D[IR] MASK[18.] DEST[HOLD] JUMP[IDIV9]  NORM $ ;IMMD

	.OPCODE[232]	;IDIVM
	FIXM2 $
	ALU[AC] ACSEL[AC] DEST[Q AR] COND[-OBUS<0] LBJUMP[IDIV2]  CYLEN[C500] $
		;LO PART TO Q, SAVE AC, CHECK SIGN

	.OPCODE[233]	;IDIVB
	FIXM2 $
	ACSEL[AC] ALU[AC] DEST[Q AR] COND[-OBUS<0] LBJUMP[IDIV3] CYLEN[C500] $

	.OPCODE[234]	;DIV
	FIXM1 $
DIV9:	ACSEL[AC+1] ALU[AC] DEST[Q] JUMP[DIV1] $ ;LO PART

	.OPCODE[235]	;DIVI
	D[IR] MASK[18.] DEST[HOLD] JUMP[DIV9] $ ;IMMD

	.OPCODE[236]	;DIVM
	FIXM2 $
	ALU[AC] ACSEL[AC+1] DEST[Q] JUMP[DIV2] $

	.OPCODE[237]	;DIVB
	FIXM2 $
	ALU[AC] ACSEL[AC+1] DEST[Q] JUMP[DIV3] $

;$*$*$	Move rest of divide code here

;------------------------------------------------------------------------------
;
;	Shifts and Rotates
;
;	Two branches are taken for each shift/rotate, depending on direction.
;	The macro SH1ST handles that.  The positive case gets ROTR loaded by
;	that macro and other negative case will have to load it itself.
;
;	Note that by the time we get here, indexing and indirection have
;	already been done, so the left half of the IR contains an honest
;	shift count, albeit not necessarily in the range -35..35
;
;------------------------------------------------------------------------------
   .DEFINE SH1ST [LAB1 LAB2]
[	D[IR] COND[OBUS18] DEST[Q] JUMP[LAB1] C550 $
	D[IR] MASK[10] DEST[Q ROTR] JUMP[LAB2] NORM $
]

	.OPCODE[240]	;ASH
	SH1ST [ASHNEG ASHPLS]

	.OPCODE[241]	;ROT
	SH1ST [ROTNEG ROTPLS]

	.OPCODE[242]	;LSH
	SH1ST [LSHNEG LSHPLS]

	.OPCODE[243]	;JFFO (a funny kind of shift instruction)
	ACSEL[AC] ALU[AC] COND[OBUS=0] JUMP[JFFO1] DEST[AR] CYLEN[C450] $
	ACSEL[AC+1] ALU[0] DEST[AC] JUMP[JFFO2] NORM $

	.OPCODE[244]	;ASHC
	ACSEL[AC+1] D[MASK 43] ALU[D&AC]   DEST[AR] NORM $
	D[AR] ROT[1] DEST[Q] JUMP[ASHC1] NORM $

	.OPCODE[245]	;ROTC
	ACSEL[AC+1] ALU[AC] DEST[Q]   NORM $
	D[IR] COND[-OBUS18] LBJUMP[ROTC1] C550 $

	.OPCODE[246]	;LSHC
	ACSEL[AC+1] ALU[AC] DEST[Q]   NORM $
	D[IR] COND[-OBUS18] LBJUMP[LSHC1] C550 $

	.OPCODE[247]	;(KAFIX at SAIL: "A. Kotok should have done this")
	ACSEL[AC] ALU[AC] DEST[HOLD AR] COND[-OBUS<0] JUMP[KAFIXP] C550 $
		;Load up things for FIXER, check for positive mantissa
	ACSEL[AC] ALU[0-AC] DEST[AR] JUMP[KAFIXN] NORM $
		;Negate AR so that its exponent can be used.
;------------------------------------------------------------------------------
;	Exchange AC and memory
;------------------------------------------------------------------------------
	.OPCODE[250]	;EXCH
	FIXM2 $
		;Finish fetch of read-modify-write, checking for faults
	ACSEL[AC] D[MEM] DEST[MEMSTO O_AC] MEMST $
		;Store result of fetch into AC, writing the old contents of
		;that AC into memory (O_AC means store new AC and output old
		;contents).

;------------------------------------------------------------------------------
;	Block Transfer Instruction
;------------------------------------------------------------------------------
	.OPCODE[251]	;BLT
	D[MASK 16] ROT[4] ACSEL[AC] ALU[D&AC] COND[OBUS=0] JUMP[BLTA1] C550 $ ;J IF DEST IS AC
	D[MASK 16] ROT[26] ACSEL[AC] ALU[D&AC] COND[-OBUS=0] LBJUMP[BLTA2] C600 $ ; J ON SRC NOT AC

;------------------------------------------------------------------------------
;	Conditional jumps which add one to both halves
;
;  Caution:	With these instructions, overflow from the right half will be
;		added to the left half, as on a KA.
;------------------------------------------------------------------------------
	.OPCODE[252]	;AOBJP
	D[CONST 1,,1] ACSEL[AC] ALU[D+AC] DEST[AC]
			COND[OBUS<0] JUMP[MAIN] C600 $
		;Add to both halves.  If result is negative, do not jump
	DOJUMP $

	.OPCODE[253]	;AOBJN
	D[CONST 1,,1] ACSEL[AC] ALU[D+AC]   DEST[AC]
	  COND[-OBUS<0] JUMP[MAIN] C600 $
	DOJUMP $

;------------------------------------------------------------------------------
;	Jump Instructions (and halts)
;
;  Caution:	Halts set PC to effective address instead of the instruction
;		that caused the halt.  This is especially bad because most
;		programs which do not use UUOs place a halt in location 40,
;		and the location of the UUO is then lost on an F2.  This
;		might be cured by replicating the instruction fetch seqeunce
;		herein with the copying of the IR into the PC happening later
;		during that sequence.
;------------------------------------------------------------------------------
	.OPCODE[254]	;JRST
	D[IR] DEST[MA PC] COND[AC=0] JUMP[MAIN1] NORM $
		;Make ordinary jumps as fast as possible.  Always load the PC
		;from the effective address, even on halts!?!
	D[IR] ROT[12] MASK[1] COND[OBUS=0] LBJUMP[JRST1] C550 $
		;Seperate according to the 10 bit of the AC field.

	.OPCODE[255]	;JFCL
	D[IR] ROT[15] MASK[4] DEST[AR] COND[AC=0] JUMP[MAIN] NORM $
		;Check AC field and jump to instruction fetch if zero.
		;JFCL 0,  is the fastest no-op on a KA
	D[PC] DEST[Q] JUMP[JFCL1] NORM $

	.OPCODE[256]	;XCT
	FIXM1 COND[-AC=0] JUMP[XCT1] $
	D[PC] ALU[D-1] DEST[PC] JUMP[XCT2] NORM $

	.OPCODE[257]	;A No-Op on KA's not having special features
	JUMP[MAIN] NORM $

;------------------------------------------------------------------------------
;
;	Stack Instructions
;
;  Caution:	If a stack crosses zero (i.e. a carry from the right half
;		occurs, the left half will be off by one, as on a KA
;		(People who wrap their stacks around and thru ACs deserve to
;		lose!)
;------------------------------------------------------------------------------
	.OPCODE[260]	;PUSHJ
	ACSEL[AC] D[CONST 1,,1] ALU[D+AC]   DEST[AC MA]
	  COND[CRY0] JUMP[PDLO1] C600 $
		;Increment stack pointer.
		;Jump on overflow (overflow code will complete instruction)
	D[PC] DEST[MEMSTO] JUMP[PUSHJ1] NORM $
		;Store the PC and flags on the stack

	.OPCODE[261]	;PUSH
	FIXM1 $
		;Complete fetch of thing to push
	D[MEM] DEST[AR] JUMP[PUSH1] NORM $
		;Move it somewhere else so we set MA to point to stack.
		;(Setting the MA implies a read, which would destroy the thing
		;to push).
		;*$*$* Go elsewhere to finish instruction

	.OPCODE[262]	;POP
	ACSEL[AC] D[CONST 1,,1] ALU[AC-D] DEST[MA O_AC]
			COND[-CRY0] JUMP[PDLO3] C600 $
		;Decrement stack pointer, but setting the MA to the old top of
		;stack.
		;If stack underflow, jump.  (Underflow code will finish the
		;instruction).
	 MAPF[PPOP] ACSEL[MA] ALU[AC] DEST[FIXMAC-MAPF-RD]
			JUMP[POP1] CYLEN[FIXM] $
		;If page fault, trap to special code to handle POP
		;*$*$* Go elsewhere to finish instruction

	.OPCODE[263]	;POPJ
	ACSEL[AC] D[CONST 1,,1] ALU[AC-D] DEST[MA O_AC]
			COND[-CRY0] JUMP[PDLO4] C600 $
		;Decrement stack pointer, but setting the MA to the old top of
		;stack.
		;If stack underflow, jump.  (Underflow code will finish the
		;instruction).
	MAPF[PPOP] ACSEL[MA] ALU[AC] DEST[FIXMAC-MAPF-RD]
			JUMP[POPJ1] CYLEN[FIXM] $
		;If page fault, trap to special code to handle POP
		;*$*$* Go elsewhere to finish instruction

	.OPCODE[264]	;JSR
	D[PC] DEST[AR MEMSTO] COND[MA-AC] JUMP[JSR2] NORM $
		;Write PC (and flags) into effective address.
		;Watch for special case of store into AC
	MAPF[STO] D[MA] ALU[D+1] DEST[PC] SPEC[CLR-HALF]
			JUMP[MAIN] CYLEN[MEMSTO] $
		;Set PC into one after effective address (where we stored old
		;PC) and take next instruction from there.
		;Make sure some nurd hasn't left the BIS flag on. (*** i assume
		;  that's what going on here.  TVR-Apr80)

	.OPCODE[265]	;JSP
	D[PC] ACSEL[AC] DEST[AC] NORM $
		;Store PC (and flags) in AC
JSP1:	D[MA] DEST[PC] JUMP[MAIN1] SPEC[CLR-HALF] NORM $
		;Jump to effective address
		;Make sure some nurd hasn't left the BIS flag on. (*** i assume
		;  that's what going on here.  TVR-Apr80)

	.OPCODE[266]	;JSA
	D[PC] MASK[18.] DEST[O_AC AR] ACSEL[AC] NORM $
		;Copy PC into left half of AC and save old contents of AC in AR
		; DID SAVE A CYCLE WITH O_AC ****
	D[MA] ROT[18.] SPEC[LEFT] ALU[DORAC] ACSEL[AC] DEST[AC]
			JUMP[JSA1] NORM $
		;Put effective address into right half, i.e. were the old
		;contents of the AC is stored.
		;(This is the FORTRAN subroutine call, in case you were
		; wondering why it was so wierd...)
		;*$*$* (Finish instruction elsewhere)

	.OPCODE[267]	;JRA
	ACSEL[AC] ALU[AC] DEST[AR] NORM  $
		;Save the return address in AR
	D[AR] ROT[18.] MASK[18.] DEST[MA] JUMP[JRA1] NORM $
		;Begin read of location containing what's to be restored into
		;the AC (to invert a JSA)
		;*$*$* (Finish instruction elsewhere)

;------------------------------------------------------------------------------
;
;	Integer Add and Subtract
;
;------------------------------------------------------------------------------

;These two macros make xxx,xxxI,xxxM,xxxB for instructions which map into a
;single 2901 instruction involving AC and MEM.  OP is thing to put in the 
;ALU field to do this 2901 instruction.
;
;ADOP and LOGOP differ only in that ADOP sets flags, and can get integer
;overflow
;
.DEFINE ADOP [OP]
BEGIN ADOP
	FIXM1 $
	ACSEL[AC] D[MEM] ALU[ OP ] DEST[AC MA] SPEC[CRYOV&MA_PC] JUMP[MAIN1] CYLEN[FIXM+1] $

	ACSEL[AC] D[IR] MASK[18.] ALU[ OP ] DEST[AC MA] SPEC[CRYOV&MA_PC] JUMP[MAIN1] NORM $
	NOP $

	FIXM2 $
	ACSEL[AC] D[MEM] ALU[ OP ] DEST[MEMSTO]
	  SPEC[CRYOV] MEMST $

	FIXM2 $
	ACSEL[AC] D[MEM] ALU[ OP ] DEST[MEMSTO AC]
	  SPEC[CRYOV] MEMST $
END ADOP

.DEFINE LOGOP [OP]
BEGIN LOGOP
	FIXM1 $
	ACSEL[AC] D[MEM] ALU[ OP ] DEST[AC MA] SPEC[MA_PC] JUMP[MAIN1] CYLEN[FIXM+1] $

	ACSEL[AC] D[IR] MASK[18.] ALU[ OP ] DEST[AC MA] SPEC[MA_PC] JUMP[MAIN1] NORM $
	NOP $

	FIXM2 $
	ACSEL[AC] D[MEM] ALU[ OP ] DEST[MEMSTO]
	 MEMST $

	FIXM2 $
	ACSEL[AC] D[MEM] ALU[ OP ] DEST[MEMSTO AC]
	  MEMST $
END LOGOP

	.OPCODE[270]	;Opcodes 270-273: ADD,ADDI,ADDM,ADDB
	ADOP[D+AC]
		;Macro defines four instructions.  See above

	.OPCODE[274]	;Opcodes 274-277: SUB,SUBI,SUBM,SUBB
	ADOP[AC-D]
		;Macro defines four instructions.  See above

;------------------------------------------------------------------------------
;
;	Conditional Instructions
;
;	Instruction dispatch sends each group of eight instructions to one 
;	place.  The condition JCOND looks at the IR to decide whether the
;	condition specified by the low order three bits of the opcode has
;	been satisfied.
;
;------------------------------------------------------------------------------

;Compare AC to effective address
	.OPCODE[300]	;CAI
	D[IR] MASK[18.] ACSEL[AC] ALU[AC-D] COND[-JCOND] JUMP[MAIN] C600 $
	DOSKIP $

AREA260:	;Recover space from hole in instruction dispatch

;Compare AC to memory
	.OPCODE[310]	;CAM
	FIXM1 $
	D[MEM] ACSEL[AC] ALU[AC-D] COND[-JCOND] JUMP[MAIN] C600 $
DOSKP1:	DOSKIP $

AREA262:	;Recover space from hole in instruction dispatch

;Jump on AC [compared with zero]
	.OPCODE[320]	;JUMP
	D[CONST 0] ACSEL[AC] ALU[AC+D] COND[-JCOND] JUMP[MAIN] C600 $
	DOJUMP $

AREA264:	;Recover space from hole in instruction dispatch

;Skip on memory [compared with zero]
	.OPCODE[330]	;SKIP
	FIXM1 COND[AC=0] JUMP[SKIPX1] $
		;Jump if AC not loaded as side effect
	D[MEM] ALU[D-0] ACSEL[AC] DEST[AC] COND[-JCOND] JUMP[MAIN] C600 $
		;AC field (in IR) is zero.  Just skip on appropriate condition
	DOSKIP $
SKIPX1:	D[MEM] ALU[D-0] COND[-JCOND] JUMP[MAIN] C600 $
		;Load memory into AC as well as skipping on appropriate
		;condition
	DOSKIP $

AREA266:	;Recover space from hole in instruction dispatch

;Add One to AC and jump [on AC compared with zero]
	.OPCODE[340]	;AOJ
	ACSEL[AC] ALU[AC+1] DEST[AC] SPEC[CRYOV] COND[-JCOND] JUMP[MAIN] C600 $
	DOJUMP $

AREA270:	;Recover space from hole in instruction dispatch

;Add One to Memory and skip [on memory compared to zero]
	.OPCODE[350]	;AOS
	FIXM2 COND[AC=0] JUMP[ASOS1]  $
		;Finish fetch part of read-modify-write
		;Jump if AC is not loaded as a side effect.
	D[MEM] ALU[D+1] ACSEL[AC] DEST[AC MEMSTO] SPEC[CRYOV]
			COND[JCOND] LBJUMP[ASOS2] C600 $
		;(AC field (in IR) is non-zero.  Load AC as side effect.)
		;Increment memory and store result in AC.
		;Set flags (set overflow if memory was 377777,,777777)
		;Decide where or not to skip before checking for store to AC
	.PAIR
ASOS2:	MEMST $
		;Do not skip.  Finish store (checking for store to AC)
	D[PC] ALU[D+1] DEST[PC] MEMST $
		;Do skip.  Finish store.
;	---
ASOS1:	D[MEM] ALU[D+1] DEST[MEMSTO] SPEC[CRYOV]
			COND[JCOND] LBJUMP[ASOS2] C600 $
		;Simply increment memory location.  Otherwise, same as above.

AREA272 = .	;Recover space from hole in instruction dispatch

;Subtract One from AC and jump [on AC compared with zero]
	.OPCODE[360]	;SOJ
	ACSEL[AC] ALU[AC-1] DEST[AC] SPEC[CRYOV] COND[-JCOND] JUMP[MAIN] C600 $
	DOJUMP $

AREA274:	;Recover space from hole in instruction dispatch

;Subtract One from Memory and skip [on memory compared to zero]
	.OPCODE[370]	;SOS
	FIXM2 COND[AC=0] JUMP[ASOS3] $
		;Finish fetch part of read-modify-write
		;Jump if AC is not loaded as a side effect.
	D[MEM] ALU[D-1] ACSEL[AC] DEST[AC MEMSTO] SPEC[CRYOV]
			COND[JCOND] LBJUMP[ASOS2] C600 $
		;(AC field (in IR) is non-zero.  Load AC as side effect.)
		;Decrement memory and store result in AC.
		;Set flags (set overflow if memory was 400000,,0)
		;Decide where or not to skip before checking for store to AC
ASOS3:	D[MEM] ALU[D-1] DEST[MEMSTO] SPEC[CRYOV]
			COND[JCOND] LBJUMP[ASOS2] C600 $
		;Simply decrement memory location.  Otherwise, same as above.

AREA276 = .	;Recover space from hole in instruction dispatch
;------------------------------------------------------------------------------
;
;	Boolean Instructions
;
;------------------------------------------------------------------------------

.DEFINE CLRAC [] [ ALU[0] ACSEL[AC] DEST[AC] NORM ]

	.OPCODE[400]	;SETZ
	CLRAC   JUMP[MAIN] $

	.OPCODE[401]	;SETZI
	CLRAC   JUMP[MAIN] $

	.OPCODE[402]	;SETZM
	  ALU[0] DEST[MEMSTO] MEMST $

	.OPCODE[403]	;SETZB
	  ALU[0] DEST[MEMSTO AC] MEMST $

	.OPCODE[404]	;AND,ANDI,ANDM,ANDB
		;Generates code for four instructions.  See ADD (ADOP)  
	LOGOP[D&AC]

	.OPCODE[410]	;ANDCA
	FIXM1 $
	ACSEL[AC] ALU[NOTAC] DEST[Q] JUMP[ANDCA1] CYLEN[FIXM+1] $

	.OPCODE[411]	;ANDCAI
	ALU[NOTAC] DEST[Q] ACSEL[AC] NORM $
	D[IR] MASK[18.] ACSEL[AC] ALU[D&Q] DEST[AC MA] SPEC[MA_PC]
			JUMP[MAIN1] NORM $

	.OPCODE[412]	;ANDCAM
	FIXM2 $
	ACSEL[AC] ALU[NOTAC] DEST[Q] JUMP[ANDCA2] CYLEN[FIXM+1] $

	.OPCODE[413]	;ANDCAB
	FIXM2 $
	ACSEL[AC] ALU[NOTAC] DEST[Q] JUMP[ANDCA3] CYLEN[FIXM+1] $

	.OPCODE[414]	;SETM,SETMI,SETMM,SETMB
SETM:	LOGOP[ D ]

	.OPCODE[420]	;ANDCM,ANDCMI,ANDCMM,ANDCMB
	LOGOP[-D&AC]

	.OPCODE[424]	;SETA,SETAI,SETAM,SETAB
	LOGOP[ AC ] $

	.OPCODE[430]	;XOR,XORI,XORM,XORB
	LOGOP[AC#D]

	.OPCODE[434]	;IOR,IORI,IORM,IORB
	LOGOP[DORAC]

	.OPCODE[440]	;ANDCB
	FIXM1 $
	ACSEL[AC] ALU[DORAC] DEST[Q] D[MEM] JUMP[ACBI1] CYLEN[FIXM+1] $

	.OPCODE[441]	;ANDCBI
	  ACSEL[AC] D[IR] MASK[18.] ALU[DORAC] DEST[Q] NORM $
ACBI1:	ACSEL[AC] ALU[NOTQ] DEST[AC MA] SPEC[MA_PC] JUMP[MAIN1] NORM $

	.OPCODE[442]	;ANDCBM
	FIXM2 $
	ACSEL[AC] ALU[DORAC] D[MEM] DEST[Q] JUMP[LOG2] CYLEN[FIXM+1] $

	.OPCODE[443]	;ANDCBB
	FIXM2 $
	ACSEL[AC] ALU[DORAC] D[MEM] DEST[Q] JUMP[LOG3] CYLEN[FIXM+1] $

	.OPCODE[444]	;EQV,EQVI,EQVM,EQVB
	LOGOP[AC/#D]

	.OPCODE[450]	;SETCA,SETCAI,SETCAM,SETCAB
	LOGOP[NOTAC]

	.OPCODE[454]	;ORCA
	FIXM1 $
	ACSEL[AC] D[MEM] ALU[-D&AC] DEST[Q] JUMP[OCAI1] CYLEN[FIXM+1] $

	.OPCODE[455]	;ORCAI
	  ACSEL[AC] D[IR] MASK[18.] ALU[-D&AC] DEST[Q] NORM $
OCAI1:	ACSEL[AC] ALU[NOTQ] DEST[AC MA] SPEC[MA_PC] JUMP[MAIN1] NORM $

	.OPCODE[456]	;ORCAM
	FIXM2 $
	ACSEL[AC] ALU[-D&AC] D[MEM] DEST[Q] JUMP[LOG2] CYLEN[FIXM+1] $

	.OPCODE[457]	;ORCAB
	FIXM2 $
	ACSEL[AC] ALU[-D&AC] D[MEM] DEST[Q] JUMP[LOG3] CYLEN[FIXM+1] $

	.OPCODE[460]	;SETCM,SETCMI,SETCMM,SETCMB
	LOGOP[NOTD]

	.OPCODE[464]	;ORCM,ORCMI,ORCMM,ORCMB
	FIXM1 $
	D[MEM] ALU[NOTD] DEST[Q] JUMP[OCMI1] CYLEN[FIXM+1] $

	.OPCODE[465]	;ORCMI
	  D[IR] MASK[18.] ALU[NOTD] DEST[Q] NORM $
OCMI1:	ACSEL[AC] ALU[QORAC] DEST[AC MA] SPEC[MA_PC] JUMP[MAIN1] NORM $

	.OPCODE[466]	;ORCMM
	FIXM2 $
	D[MEM] ALU[NOTD] DEST[Q] JUMP[ORCM2] CYLEN[FIXM+1] $

	.OPCODE[467]	;ORCMB
	FIXM2 $
	D[MEM] ALU[NOTD] DEST[Q] JUMP[ORCM3] CYLEN[FIXM+1] $

	.OPCODE[470]	;ORCB
	FIXM1 $
	ACSEL[AC] D[MEM] ALU[D&AC] DEST[Q] JUMP[OCBI1] CYLEN[FIXM+1] $

	.OPCODE[471]	;ORCBI
	  ACSEL[AC] D[IR] MASK[18.] ALU[D&AC] DEST[Q] NORM $
OCBI1:	ACSEL[AC] ALU[NOTQ] DEST[AC MA] SPEC[MA_PC] JUMP[MAIN1] NORM $

	.OPCODE[472]	;ORCBM
	FIXM2 $
	ACSEL[AC] ALU[D&AC] D[MEM] DEST[Q] JUMP[LOG2] CYLEN[FIXM+1] $

	.OPCODE[473]	;ORCBB
	FIXM2 $
	ACSEL[AC] ALU[D&AC] D[MEM] DEST[Q] JUMP[LOG3] CYLEN[FIXM+1] $

	.OPCODE[474]	;SETO
	ACSEL[AC] ALU[-1] DEST[AC MA] SPEC[MA_PC] JUMP[MAIN1] NORM $

	.OPCODE[475]	;SETOI
	ACSEL[AC] ALU[-1] DEST[AC MA] SPEC[MA_PC] JUMP[MAIN1] NORM $

	.OPCODE[476]	;SETOM
	ALU[-1] DEST[MEMSTO] MEMST     $

	.OPCODE[477]	;SETOB
	ALU[-1] ACSEL[AC] DEST[MEMSTO AC] MEMST $
	NOP $
;------------------------------------------------------------------------------
;
;	Half Word Instructions
;
;------------------------------------------------------------------------------

.DEFINE MH1 [ RR MM SS RR2 D1 OP1 JJ CYL1 D2 SS1  ]
[	FIXM1 $
	D[MEM] ROT[ RR ] MASK[ MM ] SPEC[ SS ] ACSEL[AC] DEST[AC MA] JUMP[MAIN1] CYLEN[FIXM+1] $
	D[MA] ROT[RR] MASK[ MM ] SPEC[ SS ] ACSEL[AC] DEST[AC MA] JUMP[MAIN1] NORM $
	NOP $
	D[MASK 22] ROT[ RR2 ] ACSEL[AC] ALU[D&AC] DEST[ D1 ] COND[-MA-AC] OP1 [ JJ ]  CYLEN[ CYL1 ] $
	D[AR] ROT[18.] DEST[MEMSTO] MEMST $
	ACSEL[MA] ALU[AC] COND[MA-AC] JUMP[ D2 ] DEST[FIXMAC-MAPF-WRT] MAPF[3] CYLEN[FIXM] $
	D[MEM] ROT[ RR ] MASK[ MM ] SPEC[ SS1 ] DEST[MEMSTO] COND[-AC=0] LBJUMP[HSMN1] CYLEN[FIXM+1] $
]

.DEFINE MH2 [ RR MM SS CC OP DST RR2 DST2 CC2 OP2 JJ CYL2 RR3 DST3 CC4 ]
[	FIXM1 $
	D[MEM] ROT[ RR ] MASK[ MM ] SPEC[ SS ] ACSEL[AC] DEST[AC AR] COND[ CC ] OP [ DST ] CYLEN[FIXM+1] $
	D[MA] ROT[ RR ] MASK[ MM ] SPEC[ SS ] ACSEL[AC] DEST[AC AR] COND[ CC ] OP [ DST ] NORM $
	NOP $
	D[MASK 22] ROT[ RR2 ] ACSEL[AC] ALU[DORAC] DEST[Q DST2 ] COND[ CC2 ] OP2[JJ] CYLEN[ CYL2 ] $
	D[AR] ROT[RR3] DEST[MEMSTO] MEMST $
	FIXM2 $
	D[MEM] ROT[ RR ] DEST[Q AR] COND[ CC4 ] LBJUMP[ DST3] CYLEN[FIXM+1] $
]

.DEFINE MH3 [ RR MM SS JDST RR2 JDST2 DST OP1 JJ ]
[	FIXM1 $
	D[MEM] ROT[ RR ] MASK[ MM ] SPEC[ SS ] ACSEL[AC] DEST[O_AC AR] JUMP[ JDST ] CYLEN[FIXM+1] $
	D[MA] ROT[ RR ] MASK[ MM ] SPEC[ SS ] ACSEL[AC] DEST[O_AC AR] JUMP[ JDST ] NORM $
	NOP $
	FIXM2 $
	D[MASK 22] ROT[ RR2 ] ACSEL[AC] ALU[D&AC] DEST[Q AR] JUMP[ JDST2 ] CYLEN[FIXM+1] $
	ACSEL[MA] ALU[AC] DEST[ DST ] MAPF[3] COND[-AC=0] OP1[JJ] CYLEN[FIXM] $
	D[MEM] ROT[ RR ] MASK[ MM ] SPEC[ SS ] DEST[Q AR] COND[-AC=0] LBJUMP[HHS] CYLEN[FIXM+1] $
]

	.OPCODE[500]	;HLL,HLLI,HLLM,HLLS
	MH3[ 0 0 LEFT HRAR 22 HLLM1 0 LBJUMP HMV ]
;HRL
	MH3[ 22 0 LEFT HRAR 0 HRLM1 FIXMAC-MAPF-WRT CONTA 0]
;HLLZ
	MH1[0 0 LEFT&MA_PC 22 MEMSTO LBJUMP MSMAIN NORM HLLZS1 LEFT]
;HRLZ
	MH1[22 0 LEFT&MA_PC 0 AR CONTA 0 NORM HRLZS1 LEFT]
;HLLO
	MH2[0 44 0 0 JUMP HOR 0 MEMSTO -MA-AC LBJUMP MSMAIN NORM 0 HLLOS1 -AC=0]
;HRLO
	MH2[22 44 0 0 JUMP HOR 22 AR 0 CONTA 0 NORM 22 HLLOS1 -AC=0]
;HLLE
	MH2[0 0 LEFT OBUS<0 LBJUMP HLSZ 0 AR -OBUS<0 JUMP HLLEM1 C550 0 HLLES1 OBUS<0 ]
;HRLE
	MH2[22 0 LEFT OBUS<0 LBJUMP HLSZ 22 AR -OBUS18 JUMP HRLEM1 C550 22 HLLES1 OBUS<0 ]
;HRR
	MH3[0 22 0 HLAR 0 HRRM1 0 LBJUMP HMV ]
;HLR
	MH3[22 22 0 HLAR 22 HLRM1 FIXMAC-MAPF-WRT CONTA 0]
;HRRZ
	MH1[0 22 MA_PC 0 MEMSTO LBJUMP MSMAIN NORM HRRZS1 0]
;HLRZ
	MH1[22 22 MA_PC 22 AR CONTA 0 NORM HLRZS1 0]
;HRRO
	MH2[0 44 0 0 JUMP HOL 22 MEMSTO -MA-AC LBJUMP MSMAIN NORM 0 HRROS1 -AC=0]
;HLRO
	MH2[22 44 0 0 JUMP HOL 0 AR 0 CONTA 0 NORM 22 HRROS1 -AC=0]
;HRRE
	MH2[0 22 0 OBUS18 LBJUMP HRSZ 22 AR -OBUS18 JUMP HRREM1 C550 0 HRRES1 OBUS18]
;HLRE
	MH2[22 22 0 OBUS18 LBJUMP HRSZ 0 AR -OBUS<0 JUMP HLREM1 C550 22 HRRES1 OBUS18]

;------------------------------------------------------------------------------
;
;	Bit Test Instructions
;
;  Caution:	Instruction dispatch for these instructions is peculiar.
;
;------------------------------------------------------------------------------

	.OPCODE[600]	;TRN GROUP
	  D[IR] MASK[18.] ACSEL[AC] ALU[D&AC]
	    SPEC[MA_PC] DEST[MA] COND[-JCOND] JUMP[MAIN1] C550 $
	DOSKIP $

	.OPCODE[601]	;TLN GROUP
	  D[IR] ROT[18.] ACSEL[AC] ALU[D&AC]
	    SPEC[LEFT&MA_PC] DEST[MA] COND[-JCOND] JUMP[MAIN1] C550 $
	DOSKIP $

   .DEFINE T2GRP [OP RR MM SS]
[	ACSEL[AC] D[IR] ROT[RR] MASK[MM] SPEC[SS] ALU[OP] DEST[AC] NORM $
	DOSKIP $
]

;Following code is NOT dispatched to, it is JUMPed to.
TRZ1:	T2GRP [-D&AC 0 22 0 ]
TLZ1:	T2GRP [-D&AC 22 0 LEFT]
TRO1:	T2GRP [DORAC 0 22 0]
TLO1:	T2GRP [DORAC 22 0 LEFT]
TRC1:	T2GRP [D#AC 0 22 0]
TLC1:	T2GRP [D#AC 22 0 LEFT]

;(No space left before dispatch entry)

	.OPCODE[610]	;TDN GROUP
	FIXM1 $
	D[MEM] ACSEL[AC] ALU[D&AC] COND[JCOND] LBJUMP[SKMAIN] C600 $
	.OPCODE[611]	;TSN GROUP
	FIXM1 $
	D[MEM] ACSEL[AC] ROT[18.] ALU[D&AC] COND[JCOND] LBJUMP[SKMAIN] C600 $

;(Following is not dispatched to.  It probably belongs with MSMAIN, etc.)
	.PAIR
SKMAIN:	SPEC[MA_PC] DEST[MA] JUMP[MAIN1] NORM $
	DOSKIP $

AREA342:	;Recover space from hole in instruction dispatch

  .DEFINE T1GRP [OP RR MM SS1 SS2 D1]
[	ACSEL[AC] D[IR] ROT[RR] MASK[MM] SPEC[SS1] ALU[D&AC] COND[JCOND] JUMP[D1] C550 $
	ACSEL[AC] D[IR] ROT[RR] MASK[MM] SPEC[SS2] ALU[OP] DEST[AC MA] JUMP[MAIN1] NORM $
]
	.OPCODE[620]	;TRZ GROUP
	T1GRP [-D&AC 0 22 0 MA_PC TRZ1]

	.OPCODE[621]	;TLZ GROUP
	T1GRP [-D&AC 22 0 LEFT LEFT&MA_PC TLZ1]

AREA344:	;Recover space from hole in instruction dispatch

	.OPCODE[630]	;TDZ
	FIXM1 $
	ALU[AC] ACSEL[AC] DEST[Q] JUMP[TDZ1] NORM $

	.OPCODE[631]	;TSZ
	FIXM1 $
	ALU[AC] ACSEL[AC] DEST[Q] NORM $
;	\ /
;Following is not in instruction dispatch
	ACSEL[AC] D[MEM] ROT[18.] ALU[-D&AC] DEST[AC] SHORT $
TSZ2:	D[MEM] ROT[18.] ALU[D&Q] COND[JCOND] LBJUMP[SKMAIN] C600 $
TDZ1:	ACSEL[AC] D[MEM] ALU[-D&AC] DEST[AC] SHORT $
TDZ2:	D[MEM] ALU[D&Q] COND[JCOND] LBJUMP[SKMAIN] C600 $

AREA346:	;Recover space from hole in instruction dispatch

	.OPCODE[640]	;TRC GROUP
	T1GRP [D#AC 0 22 0 MA_PC TRC1]

	.OPCODE[641]	;TLC GROUP
	T1GRP [D#AC 22 0 LEFT LEFT&MA_PC TLC1]

AREA350:	;Recover space from hole in instruction dispatch

	.OPCODE[650]	;TDC
	FIXM1 $
	ALU[AC] ACSEL[AC] DEST[Q] JUMP[TDC1] NORM $

	.OPCODE[651]	;TSC
	FIXM1 $
	ALU[AC] ACSEL[AC] DEST[Q] NORM $
	ACSEL[AC] D[MEM] ROT[18.] ALU[AC#D] DEST[AC] JUMP[TSZ2] NORM $
TDC1:	ACSEL[AC] D[MEM] ALU[AC#D] DEST[AC] JUMP[TDZ2] NORM $

AREA352:	;Recover space from hole in instruction dispatch

	.OPCODE[660]	;TRO GROUP
	T1GRP [DORAC 0 22 0 MA_PC TRO1]

	.OPCODE[661]	;TLO GROUP
	T1GRP [DORAC 22 0 LEFT LEFT&MA_PC TLO1]

AREA354:	;Recover space from hole in instruction dispatch

	.OPCODE[670]	;TDO GROUP
	FIXM1 $
	ALU[AC] ACSEL[AC] DEST[Q] JUMP[TDO1] NORM $

	.OPCODE[671]	;TSO GROUP
	FIXM1 $
	ALU[AC] ACSEL[AC] DEST[Q] NORM $
	ACSEL[AC] D[MEM] ROT[18.] ALU[DORAC] DEST[AC] JUMP[TSZ2] NORM $
TDO1:	ACSEL[AC] D[MEM] ALU[DORAC] DEST[AC] JUMP[TDZ2] NORM $

AREA356:	;Recover space from hole in instruction dispatch
; IOT GROUP -- FOR NOW

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;									;;;;
;;;;	CAUTION: Hardware currently does not check for User when doing	;;;;
;;;;	IOTs.  Most, but not all, now check it in micro code.  The	;;;;
;;;;	instruction dispatch hardware is probably the right place to	;;;;
;;;;	check for this, but try to convince Poole of that...		;;;;
;;;;									;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


.repeat 0[
.DEFINE IOTDIS [ WHERE ]
[	D[IR] ROT[15] MASK[4] DEST[Q] NORM $
	D[IR] ROT[15] MASK[4] ALU[D+Q] DEST[Q] SHORT $
	D[CONST WHERE] ROT[6] ALU[DORQ] SDISP CYLEN[C500] $
]
];repeat 0

.DEFINE IOTDIS [ WHERE ]
[	D[IR] ROT[16] MASK[5] DEST[Q] NORM $
	D[CONST WHERE] ROT[6] ALU[DORQ] SDISP CYLEN[C500] $
];.DEFINE IOTDIS
	;Bit 14 is guaranteed zero by instruction decode process and therefore
	;doubling can be obtained by extraction.   TVR-Apr80

	.OPCODE[700]	;APR & PI
	MAPF[2] D[CONST 6] DEST[DEV-ADR] COND[-USER] LBJUMP[APIOT] NORM $
	NOP $

	.OPCODE[701]
	ILGIOT $
	NOP $

	.OPCODE[702]	;UNUSED & MAP
	MAPF[2] D[CONST 1] DEST[DEV-ADR] NORM $
	D[IR] ROT[15] MASK[4] DEST[Q] COND[-USER] LBJUMP[MAPIOT] NORM $

.REPEAT 7 [ILGIOT $
	NOP $
	 ]

	.OPCODE[712]	;CTY & LPT
	MAPF[2] D[CONST 4] DEST[DEV-ADR] NORM COND[-USER] LBJUMP[CTYIOT] $
	NOP $

	ILGIOT $
	 NOP $
	ILGIOT $
	 NOP $

;DISK CTRL IOTS-- 140 - 174

	.OPCODE[715]	;DISK CTRL IOTS-- OPCODES 715 TO 724
	D[CONST 10] DEST[DEV-ADR] SPEC[IOB-IN] COND[USER] JUMP[UDSKST] $
	 MAPF[0] D[IOD] DEST[MEMSTO] 
		COND[-MA-AC] LBJUMP[SMAIN] $
	D[CONST 10] DEST[DEV-ADR] SPEC[IOB-IN] COND[USER] JUMP[UDSKST] $
	 MAPF[1] D[IOD] DEST[MEMSTO] 
		COND[-MA-AC] LBJUMP[SMAIN] $
	D[CONST 10] DEST[DEV-ADR] SPEC[IOB-IN] COND[USER] JUMP[UDSKST] $
	 MAPF[2] D[IOD] DEST[MEMSTO] 
		COND[-MA-AC] LBJUMP[SMAIN] $
	D[CONST 10] DEST[DEV-ADR] SPEC[IOB-IN] COND[USER] JUMP[UDSKST] $
	 MAPF[3] D[IOD] DEST[MEMSTO] 
		COND[-MA-AC] LBJUMP[SMAIN] $
	FIXML PUSHJ[SET-DSK-OUT] $ ;ld cmd -- opcode 721
	 MAPF[4] d[ar] DEST[2]  DEST-A-MEM JUMP[MAIN] $
	FIXML PUSHJ[SET-DSK-OUT] $
	 MAPF[5] DEST[MA]  SPEC[MA_PC] 	JUMP[MAIN1] $
	FIXML PUSHJ[SET-DSK-OUT] $
	 MAPF[6] DEST[MA]  SPEC[MA_PC] 	JUMP[MAIN1] $
	FIXML PUSHJ[SET-DSK-OUT] $
	 MAPF[7] DEST[MA]  SPEC[MA_PC] 	JUMP[MAIN1] $
	
;TAPE IOTS - OPCODES 725 - 732 --Dispatch entries on page headed ";TAPE DISP"


.OPCODE[733]

  .REPEAT  4 [ILGIOT $	;SKIP OPCODES 733 - 736
	NOP $
  ]
	.OPCODE[737]	;DLS iot's (DLS is device 370)
 .REPEAT 1 - DLS [ 	;If DLS present, this entry is part of DLS code.
	D[IR] ROT[12.] C550 COND[OBUS<0] JUMP[MAIN] $
	  ;If it can't be a CONSZ, do nothing.
	D[PC] ALU[D+1] DEST[PC] NORM JUMP[MAIN] $
	  ;If it could be a CONSZ, assume it is and perform a skip.
  ] ;1 - DLS

   ;skip space for disk cono,coni, etc. OPS 740 - 743
   ;locs 3700 to 3707
	  ; these dispatch entries are on dsk page.

	.OPCODE[744]	;Tymnet opcodes (or undefined)
 .repeat 1 - TYMNET - DR11P [
	.repeat 4 [ ilgiot $  nop $  ;if no tymnet, 744-747 = nop
		   ]
		   ]

.repeat tymnet [
   ;skip space for TYMNET IOTS.  OPS 744 - 747
	  ; these dispatch entries are on TYMNET page.
    ]

	.OPCODE[750]	 ;READ ECC INFO
	D[11] A-MEM-APR DEST[MEMSTO] MEMST $
	 ;Get info on last ECC error from A-MEM(1), store in eff. adr.
	NOP $

	.OPCODE[751]	;Undefined
	ILGIOT $
	NOP $

	.OPCODE[752]	;
.REPEAT 1 - VC [
	ILGIOT $
	NOP $
];.REPEAT 1 - VC
.REPEAT VC [		;Versatec
	D[CONST VCDEV] DEST[DEV-ADR] NORM COND[-USER] LBJUMP[VCIOT] $
		;Set micro device address for Versatec and check for
		;IOT-User mode
	NOP $
];.REPEAT VC

	.OPCODE[753]	;Undefined
	ILGIOT $
	NOP $

	.OPCODE[754]	;Undefined
	ILGIOT $
	NOP $

	.OPCODE[755]	;IMP (BBN), device code 550
.REPEAT 1 - IMP [ILGIOT $
	NOP $
];1 - IMP

.REPEAT IMP [	;Reserve space for the IMP IOT dispatch instructions
IMP-IOT:
];IMP

	.OPCODE[756]	;Undefined
.REPEAT (757 - 756 + 1) [ILGIOT $
	NOP $
 ]

TIMER-IOTS:
  
	.OPCODE[760]	;760:765
.REPEAT 0 * (1 - TIMER) * (765 - 760 + 1) [ILGIOT $
	NOP $
 ]
;;; : TIMER-IOTS + 12.	;LEAVE SPACE FOR OPCODES 760-765
;*** This is an unreasonably large waste of opcode space.  It should dispatch
;*** on the AC field at least if normal PDP-10 I/O opcodes aren't suitable.
;*** Furthermore, this kind of opcode has no chance of being properly
;*** disassembled by DDT.					TVR-Apr80

	.OPCODE[774]
.REPEAT STANSW [			;OP 774
	D[CONST GRN-UDEV] DEST[DEV-ADR] NORM COND[-USER] LBJUMP[GRNIOT] $
		;Set micro device address for Grinnell and check for
		;IOT-User mode
	NOP $
]
.REPEAT 1 - STANSW [CURRENTLY-UNUSED[1]  JUMP[MAIN] $

	NOP $
]

	.OPCODE[775]

 .REPEAT 1 [
	
;CAM -- A COPY OF CAM WHICH HALTS IF IT DOESN'T SKIP.  WOW !
	FIXM1 $
	D[MEM] ACSEL[AC] ALU[AC-D] COND[JCOND] JUMP[DOSKP1] C600 $
	D[MEM] CURRENTLY-UNUSED[1] JUMP[.] $

;;DSKWT  -- DELAY UNTIL DISK NOT BUSY
;	JUMP[DSKWT1] $		;OPCODE 775
;	NOP $
;	NOP $
;	NOP $

]

.REPEAT 0 [ ILGIOT $
			NOP $

			ILGIOT $
			NOP $  ]

	.OPCODE[777]	;OPCODE 777 --- MAKE IT A UUO
;;;	JUMP[MUUO] $
	UAOP1 $		;Illegal instruction rather than an IOT.  It's an
			;easy thing to stumble upon in buggy programs (or
			;hardware), being it is most common negative integers

;MSTART MSTRT1 BADPC ILDB1 ILDB2 IDPB1 IDPB2 ILDB3 LDB1 LDB5 LDB2 LDB4 DPB1 DPB5 DPB7 IDPB3 DPB2 DPB4 BIIH1 BIIH BII IBP1 IBT1
;NON DISPATCH STUFF HERE

	.ORG[4000]
; INIT THINGS -- INITIALIZE MACHINE, POWER-UP COMES HERE.

MSTART:
JUMP[MSTRT1] $	;to help operator start from switches (KEEP THIS SIMPLE -- MLB)

	.USE[NORMAL]
MSTRT1:

;******* This code to be made a subroutine to allow machine resetting *******
;******* to be done by auto-loading and via CONO APR,20000  TVR-Mar80 *******

.REPEAT 1 - CROCK [	;$*$*$ This crock will shortly vanish!
;Set up vectors for unused devices 9JAN80 BO (23JAN MLB/TVR)
;This code fills the zeroth location of all the AMEM blocks with a vector to
;the address SPURIOUS-INTERRUPT, which should contain the handler for them.

	.ORG[7777]		;this is randomly here, it could be anywhere
SPURIOUS-INTERRUPT:	JUMP[.] $	;here on spurious interrupts

	.RELOC

D[CONST (SPURIOUS-INTERRUPT / 100)] ROT[6] DEST[Q] $	;Put high 6 bits in Q
..LOW6 = (SPURIOUS-INTERRUPT \ 100)
.IF ..LOW6 /= 0 [	;assemble low order 6 bits if non-zero
D[CONST ..LOW6] ALU[DORQ] DEST[Q] $
]
D[CONST 40] DEST[AR CLR-DEV-FROM-INTR] NORM $	;init AR for device num
ALU[Q] DEST[0] DEST-A-MEM NORM $		;store vector 
D[AR] ALU[D-1] DEST[AR DEV-ADR]			;decrement dev adr
	COND[-OBUS<0] JUMP[. - 1] C550 $	;and loop
];1 - CROCK


;The following code sets up the AMEM zero vectors for various random devices.
;this is a complete CROCK!  The device reset subroutines should do this!!
;I plan to fix this soon (when I have time, ha ha)	-- MLB 23JAN80
;$*$*$ Fix this soon.	TVR-Apr80

	D[CONST 20] ROT[6] DEST[Q CLR-DEV-FROM-INTR] NORM $

	.DEFINE AMLD2 [ DEV ALOC VAL ]
[	D[CONST DEV] DEST[DEV-ADR] NORM $
	D[CONST VAL] ALU[DORQ] DEST-A-MEM DEST[ALOC] NORM $
]
	AMLD2 [ 1 0 62 ] ; INTERRUPTS FROM DEV 1 (SWITCHES) GO TO 2062
	D[CONST 21] ROT[6] DEST[Q] NORM $
;;;	AMLD2 [ 4 0 30 ] ; INTERRUPTS FROM DEV 4 GO TO 2130 [Now set at CTYRST]
	AMLD2 [ 5 0 34 ] ; INTRS FROM DEV 5 GO TO 2134
	AMLD2 [ 6 0 41 ] ; INTS FROM DEV 6 GO TO 2141
	AMLD2 [ 7 0 50 ] ; INTS FROM DEV 7 GO TO 2150
	AMLD2 [ 10 0 56 ] ; INTS FROM DEV 10 GO TO 2156
.REPEAT DLS [
	AMLD2 [ DLSDEV 0 37 ] ; DLS GOES TO 2137
];DLS
;;	the IMP reset code takes care of this for itself!!

;;; Moved code to set MAP-DISP to MAPRST (due to lack of space between
;;; 4000:4777).						  TVR-Apr80
	ALU[0] DEST[CRYOV] NORM $
	ALU[0] DEST[CLR-MI-ERR] NORM $
	D[CONST 0] DEST[3] SPEC[A-MEM-APR&DEST-A-MEM] NORM $
	JUMP[RESLOP] NORM $

BADPC:	BADLOC $

;------------------------------------------------------------------------------
;$*$*$*	THIS JUNK HAS GOT TO MOVE! TVR-Apr80
;
;Some of it also needs commenting but this must be postponed until after CCRMA
;merge.
;------------------------------------------------------------------------------

	.USE[AREA260]
	.PAIR	;Goes to second if HALF is not set
ILDB1:	D[AR] ROT[14] MASK[6] DEST[MASKR] JUMP[ILDB2] NORM $
		;Extract S field.  Being HALF was set, don't increment
	D[AR] ROT[14] MASK[6] DEST[AR MASKR] COND[BYTE-OVF] PUSHJ[IBT1] NORM $
		;Extract S field.  Increment word if byte overflow will happen
	D[AR] ROT[36] ALU[Q-D] DEST[Q AR MEMSTO] -MA-AC JUMP[. + 2] NORM $
		;SUB S FROM P
		;Increment byte pointer, no overflow possible now
		;Store into memory, check for store into AC
	ACSEL[MA] D[MEM] DEST[AC] CYLEN[MEMSTO] $
		;Store is into an AC, write it there.
ILDB2:	ALU[Q] DEST[MA] COND[-MEM-IDX-IND] LBJUMP[ILDB3] NORM $
		;Fetch data, perhaps.  Maybe also do indexing or indirection
	.PAIR
IDPB1:	D[AR] ROT[14] MASK[6] DEST[MASKR] JUMP[IDPB2] NORM $
	D[AR] ROT[14] MASK[6] DEST[AR MASKR] COND[BYTE-OVF] PUSHJ[IBT1] NORM $;GET S FLD, OVFL?
	D[AR] ROT[36] ALU[Q-D] DEST[Q AR MEMSTO] COND[-MA-AC] JUMP[. + 2] NORM $;SUB S FROM P
	ACSEL[MA] D[MEM] DEST[AC] CYLEN[MEMSTO] $
IDPB2:	ALU[Q] DEST[MA] COND[-MEM-IDX-IND] LBJUMP[IDPB3] NORM $

	.PAIR	;Goes to second if not indexing or indirecting
ILDB3:	MAPF[NORM-RD] PUSHJ[BIIH] NORM $;HANDLE IDX-IND
	MAPF[BYTE-ILD] ACSEL[MA] ALU[AC] DEST[FIXMAC-MAPF-RD]
			JUMP[LDB2] CYLEN[FIXM] $
		;Finish read of data word, then go extract byte

	.USE[AREA262]
	.PAIR	;Goes to second if not indexing or indirecting
LDB1:	MAPF[2] PUSHJ[BII] NORM $
LDB5:	FIXM1 $	;Also gets here from XBY13
	D[AR] ROT[14] MASK[6] DEST[MASKR] SHORT $
		;GET S FLD
	SPEC[CLR-HALF] D[CONST 44] DEST[Q] SHORT $
	D[AR] ROT[6] MASK[6] ALU[Q-D] DEST[Q ROTR] SHORT $
		;SUB P FLD FROM 44
	D[AR] ROT[12.] MASK[6] ALU[Q-D] COND[-OBUS<0] JUMP[LDB4] C550 $
		;Also, subtract S field.  If result is positive, then byte
		;of size S fits with at least P bits remaining in the right
		;side of the word
	ALU[Q] DEST[MASKR] JUMP[LDB4] NORM $
		;Byte does not fit!!!  We want only the stuff to the left
		;of postion P, which is 36.-P bits, coincidentally, the same
		;size as the rotation
;S field is already set up.  Set up P field and extract data from word.
LDB2:	SPEC[CLR-HALF] D[CONST 44] DEST[Q] SHORT $
	D[AR] ROT[6] MASK[6] ALU[Q-D] DEST[ROTR] SHORT $
		;SUB P FLD FROM 44
LDB4:	D[MEM] ACSEL[AC] ROT[R] MASK[R] SPEC[MA_PC] DEST[MA AC] JUMP[MAIN1] NORM $; DO THE LDB


	.PAIR
DPB1:	MAPF[2] PUSHJ[BII] NORM $
DPB5:		;Also gets here from XBY13
;;;	FIXM2 $	;Wrong thing for WAITS.
	  MAPF[BYTE-IDP] CYLEN[FIXM]
			ACSEL[MA] ALU[AC] DEST[FIXMAC-MAPF-WRT] JUMP[DPB7] $
		;KA/KL set half flag even on DPB.  They would also set read
		;failure, not write, in the case of not in map; but we don't
		;have time to be particular.  			TVR-Apr80

	.USE[NORMAL]
DPB7:	D[AR] ROT[12.] MASK[6] DEST[MASKR] SHORT $
		;Fetch S field.
	SPEC[CLR-HALF] D[AR] ROT[6] MASK[6] DEST[Q ROTR] SHORT $
		;Fetch P field.
	D[CONST 44] ALU[D-Q] DEST[Q] SHORT $
		;Calculate 36-P, which is maximum number of bits in this byte
	D[AR] ROT[12.] MASK[6] ALU[Q-D] COND[-OBUS<0] JUMP[DPB4] C550 $
		;Does this byte fit?  I.e. 36-P-S is non-negative.  If so,
		;use this mask field
	ALU[Q] DEST[MASKR] JUMP[DPB4] NORM $
		;Setup mask which is everything to the left of the position
		;designated by P.

	.USE[AREA266]
	.PAIR
IDPB3:	MAPF[2] PUSHJ[BIIH] NORM $;HANDLE IDX-IND
	MAPF[BYTE-IDP] CYLEN[FIXM]
		ACSEL[MA] ALU[AC] DEST[FIXMAC-MAPF-WRT] $
	D[AR] ROT[14] MASK[6] DEST[MASKR] SHORT $
DPB2:	SPEC[CLR-HALF] D[AR] ROT[6] MASK[6] DEST[Q ROTR] SHORT $
DPB4:	D[2] MASK[R] ACSEL[AC] ALU[D&AC] DEST[AR] SHORT $;GET BYTE
	D[MEM] DEST[Q] SHORT $; GET DEST WORD
	D[2] MASK[R] ROT[R] ALU[-D&Q] DEST[Q] SHORT $;CLR DEST BYTE
	D[AR] ROT[R] ALU[DORQ] DEST[MEMSTO] MEMST $;DO IT

.DEFINE BIIMAC[BIMAPF BIIH BIIH1]
[	D[AR] ROT[18.] MASK[4] DEST[AC-SEL] COND[OBUS=0] JUMP[BIIH1] C550 $
		;IDX FLD
	D[MA] ACSEL[REG] MASK[18.] ALU[D+AC] DEST[MA] SHORT $
		;DO INDEXING
	D[AR] ROT[16] MASK[1] MAPF[2] COND[OBUS=0] POPJ CYLEN[C500] $
		;LEAVEIF NO IND
BIIH1:	ACSEL[MA] ALU[AC] DEST[FIXMAC-MAPF-RD] MAPF[BIMAPF] CYLEN[FIXM] $
	D[MEM] MASK[27] DEST[Q MA] COND[-MEM-IDX-IND] POPJ CYLEN[C500] $
		;GET INDIRECT WORD, LEAVE IF NO MORE IND OR IDX
	D[AR] ROT[14] MASK[14] DEST[AR] MAPF[2] NORM $
	D[AR] ROT[30] ALU[DORQ] DEST[Q AR] COND[-INTRPT] JUMP[BIIH] NORM $
		;Loop if no interrupt is waiting.
	PUSHJ[SETHLF] NORM $
		;Intrpt. waiting.   Set HALF (BIS) flag in PC.
	D[PC] ALU[D-1] DEST[PC] NORM JPOP[MAIN] $
		;Back up PC (so instr. will be re-executed) and take intrpt.
]
	.USE[AREA264]
BIIH:	BIIMAC [BYTE-IND BIIH BII1]

  .USE[NORMAL]

BII:	BIIMAC [NORM-RD BII BII2]

	.PAIR	;Skip if AC=0
IBP1:	UAOP1 $	;Non-zero AC implies ADJBP.  We don't, yet.
	D[AR] ROT[14] MASK[6] DEST[AR] COND[BYTE-OVF] PUSHJ[IBT1] NORM $;GET S FLD, OVFL?
		;Zero AC.  Do ordinary increment byte pointer.
		;PUSHJ if we are about to overflow a word.
	D[AR] ROT[36] ALU[Q-D] DEST[Q MEMSTO] MEMST $
		;Finish updating byte position part of pointer

;Increment byte pointer which crosses a word boundary
IBT1:	D[MASK 36] ALU[D&Q] DEST[Q] SHORT $
	D[CONST 44] ROT[36] ALU[D+Q+1] DEST[Q] POPJ NORM $
		;NEW P FLD OF 44, ADD 1 TO ADR
;IMUL1 IMUL2 IMUL3 MUL1 MUL2 MUL3 DOIMUL MSETOV DOMMUL DOMUL DOMUL1 DOMUL4 IDIV1 IDIV2 IDIV3 DIV1 DIV2 DIV3 DODDIV DODIV DODIV1 DODIV3 DODIV2 STOVFQ DODIV4 DODIV6 DODIV5

IMUL1:	ALU[0] DEST[AR O_AC] PUSHJ[DOIMUL] NORM $	;0 TO AC,AC TO AR
	ALU[Q] DEST[AC] JUMP[MAIN] NORM $
IMUL2:	ALU[0] DEST[AR O_AC] PUSHJ[DOIMUL] NORM $	;0 TO AC
	D[AR] DEST[AC] NORM $
	ALU[Q] DEST[MEMSTO] MEMST $

IMUL3:	ALU[0] DEST[AR O_AC] PUSHJ[DOIMUL] NORM $
	ALU[Q] DEST[AC MEMSTO] MEMST $

MUL1:	ALU[0] DEST[AR O_AC] PUSHJ[DOMMUL] NORM $
	ACSEL[AC+1] ALU[Q] DEST[AC] JUMP[MAIN] NORM $

MUL2:	ALU[0] DEST[AR O_AC] PUSHJ[DOMMUL] NORM $
	D[AR] DEST[O_AC MEMSTO] MEMST $
MUL3:	ALU[0] DEST[AR O_AC] PUSHJ[DOMMUL] NORM $
	ACSEL[AC+1] ALU[Q] DEST[AC] NORM $
	ALU[AC] DEST[MEMSTO] MEMST $

DOIMUL:	PUSHJ[DOMUL] NORM $
	ALU[AC] COND[OBUS=0] POPJ CYLEN[C500] $; NO OV IF 0
	ALU[NOTAC] COND[OBUS=0] POPJ CYLEN[C500] $; NO OV IF -1
MSETOV:	D[PC] DEST[AC] SHORT $; GET FLAGS
MSTOV1:	D[CONST 1] ROT[43] ALU[DORAC] DEST[CRYOV] NORM POPJ $; SET OV
DOMMUL:	D[AR] ALU[D#Q] COND[-OBUS=0] JUMP[DOMUL] CYLEN[C500] $; NO OV IF DIFF OPERS
	D[CONST 1] ROT[43] ALU[D#Q] COND[-OBUS=0] JUMP[DOMUL] CYLEN[C500] $; J IF NOT -2**35
	PUSHJ[MSETOV] NORM $;SET OV
	ALU[0] DEST[AC] SHORT $
DOMUL:	D[CONST 42] LLOAD NORM $	;LOOP 35 TIMES

DOMUL1:	D[AR] ALU[MULAC+D] DEST[D4] MASK[3]
			LOOP[DOMUL1] NORM $ ;SHIFT, END-COND MUL; SOJGE, SH RT
		;This shifts right, with the low order bit of the partial
		;product being saved in Q.  At the same time, shift out of Q
		;a bit of the multiplier (and somehow??? the hardware uses this
		;to decide whether to add or not???)
		;MASK field specifies what gets shifted into AC, in this case,
		;(ALU OV) XOR (-OUT<0)
	D[AR] ALU[MULAC+D] DEST[D4] MASK[3]
			COND[-Q0-35] JUMP[. + 2] CYLEN[C450] $ ;J IF QUOT WAS +
		;Do last step of multiply. Jump on sign of multiplier(?)
	D[AR] ALU[MULAC-D] DEST[D7]
			JUMP[. + 2] NORM $ ; DEST AC SH LFT, ALU=1, ALU S=0
		;Multiplier was positive... ???: Shift left to make properly
		;signed result, with low order bit coming from Q0 (i think???)
	ALU[SH-AC] DEST[D7] NORM $ ;DEST AC SH LFT
		;SINCE DEST IS >3, ALU[QORAC] IS ALU[AC]
		;Multiplier was negative... ???
	ALU[AC] COND[OBUS<0] LBJUMP[DOMUL4] CYLEN[C500] $
		;Decide what sign should be in the low order result.

	.PAIR
DOMUL4:	D[MASK 35.] ALU[D&Q] DEST[Q] POPJ NORM $
		;Positive.  Turn off Q0, which was copied into AC35.
	D[CONST 1] ROT[35.] ALU[DORQ] DEST[Q] POPJ NORM $
		;Negative.  Set Q0 so the number is negative (Q0 was copied into
		;AC35).

  CCC1	= SHORT $	;Apparently used as a NO-OP for macros below. TVR-Apr80
  MEMST1 = MEMST $	;Store to memory. (Cause macro expansion now, rather
			;than in macro call.)

.DEFINE DMACFN [AA A2 D1 D2 OP1]
[	ALU[AA] D[AR] DEST[O_AC AR] SHORT $
	ACSEL[AC+1] D[AR] ALU[A2] DEST[D1 D2] OP1 $
	ALU[AC] DEST[MEMSTO] MEMSTMA $
]
.DEFINE DMAC2 []
[	D[MEM] ALU[D#AC] DEST[AR] PUSHJ[DODDIV] NORM $
]
.DEFINE DMAC1 []
[	.PAIR
	ALU[-1] DEST[AC] JUMP[. + 2] NORM $
	ALU[0] DEST[AC] SHORT $
	D[MEM] ALU[D#AC] DEST[AR] SHORT $
	D[AR] ROT[1] MASK[1] DEST[IR-ADR] SHORT $
	ALU[Q] DEST[AR] PUSHJ[DODIV] NORM $
]

IDIV1:	DMAC1
	DMACFN[Q D AC MA DOM1]
IDIV2:	DMAC1
	DMACFN[D Q MEMSTO AR MEMST1]
IDIV3:	DMAC1
	DMACFN[Q D AC 0 CCC1]
DIV1:	DMAC2
	DMACFN[Q D AC MA DOM1]
DIV2:	DMAC2
	DMACFN[D Q MEMSTO AR MEMST1]
DIV3:	DMAC2
	DMACFN[Q D AC 0 CCC1]

DODDIV:	D[AR] ROT[1] MASK[1] DEST[IR-ADR] SHORT $
	ALU[SH-AC] DEST[AR D5] MASK[1] NORM $
	D[AR] MASK[1] COND[OBUS=0] JUMP[. + 2] C550 $
	D[CONST 1] ROT[43] ALU[DORQ] DEST[Q] JUMP[. + 2] NORM $
	D[MASK 43] ALU[D&Q] DEST[Q] NORM $
;------------------------------------------------------------------------------
;
;	Single Precision Divide (and continuation of double precision)
;
;	(Reminder: Quotient, Remainder = Dividend / Divisor)
;
;Where we get here:
;    MEM	36 bit signed divisor
;    AC		High order dividend (0 or -1 for single precision)
;    Q		Low order dividend
;    IR<35>	Sign of dividend XOR sign of divisor
;    AR		Sign of dividend and original contents of AC
;  
;------------------------------------------------------------------------------
DODIV:	D[MEM] COND[-OBUS<0] JUMP[DODIV1] C550 $
		;Jump if divide by positive number
	D[MEM] ALU[0-D] DEST[HOLD] SHORT $
		;Take absolute value
DODIV1:	ALU[AC] COND[-OBUS<0] JUMP[DODIV2] CYLEN[C450] $
		;Check sign of high order word.  If positive, we're ready to go
	ALU[0-Q] DEST[Q] COND[OBUS=0] JUMP[DODIV3] CYLEN[C500] $
		;Double precision negate, low order word
	ALU[NOTAC] DEST[AC] JUMP[DODIV2] NORM $
		;High order word, no carry
DODIV3:	ALU[0-AC] DEST[AC] NORM $
		;High order word, with carry
DODIV2:	D[CONST 44] LLOAD NORM $
		;LOOP 37 TIMES
;Now have:
;   MEM		Absolute value of divisor
;   AC		Absolute value of high order dividend
;   Q		Absolute value of low order dividend
;   R		Repeat count for division
	D[MEM] ALU[AC-D] COND[OBUS<0] JUMP[DODIV7] C550 $
		;Jump if not no divide case
	D[PC] DEST[AC] SHORT $
		;Get ready to set flags
	D[CONST 1] ROT[23.] ALU[DORAC] DEST[AC] PUSHJ[MSTOV1] NORM $
		;Set no divide
	D[AR] DEST[AC] POPJ NORM $
		;Fix clobbered AC

	;$*$*$* NORMAL area runs of space for now.  TVR-Apr80
	.USE[AREA216]
DODIV7:	NORM PUSHJ[DODIV4] $
	D[AR] COND[-OBUS<0] JUMP[. + 2] C550 $; J IF DIVIDEND WAS +
	ALU[0-AC] DEST[AC] SHORT $
	D[IR] MASK[1] COND[OBUS=0] POPJ C550 $ ;LEAVE IF RESULT SHOULD BE +
	ALU[0-Q] DEST[Q] POPJ NORM $
;On completion:
;   MEM		Absolute value of divisor
;   AC		Remainder
;   Q		Quotient
;   AR<0>	Sign of dividend
;   IR<35>	Sign of dividend

	.QUAD
DODIV4:	D[MEM] ALU[DIVAC-D] DEST[D6] MASK[3] COND[OBUS<0] SLOOP[DODIV4] C600 $
	ALU[SH-AC] DEST[D5] MASK[0] JUMP[DODIV6] NORM $ ; RE-SHIFT REMAINDER
	D[MEM] ALU[DIVAC+D] DEST[D6] MASK[3] COND[OBUS<0] SLOOP[DODIV4] C600 $
	ALU[SH-AC] DEST[D5] MASK[0] NORM $
    ;end of .QUAD
DODIV6:	D[CONST 1] ROT[43] ALU[D#AC] DEST[AC] COND[-OBUS<0] C550 POPJ $ 
		;ADJUST REM SIGN, CHECK IT
	D[MEM] ALU[D+AC] DEST[AC] NORM POPJ $ 
		;ADJUST REM.

	.USE[NORMAL]
;JFFO1 JFFO2 JFFO3 JFFO5 JFFO4 ROTDO BIGLSH LSHPDO LSHDO LSHDO1 ASHDO1 BIGASH SETOV1 ASHDO ASHDOP BIGAS2 ASHC1 ASHC8 ASHC6 ASHC9 ASHC4 ASHC2 ASHC7 ROTC1 ROTC2 LSHC1 LSHC2 SJMAIN PUSH1 POP1 POPJ1 PUSHJ1

JFFO1:	ACSEL[AC+1] ALU[0] DEST[AC] JUMP[MAIN] NORM $
JFFO2:	D[AR] ROT[6] MASK[6] COND[-OBUS=0] JUMP[JFFO3] C550 $
	D[AR] ROT[6] DEST[AR] NORM $
	D[CONST 6] ACSEL[AC+1] ALU[AC+D] DEST[AC] JUMP[JFFO2] NORM $
JFFO3:	D[AR] COND[OBUS<0] JUMP[JFFO4] C550 $
JFFO5:	ACSEL[AC+1] ALU[AC+1] DEST[AC] NORM $
	D[AR] ROT[1] DEST[AR] COND[-OBUS<0] JUMP[JFFO5] C550 $
JFFO4:	D[IR] DEST[PC MA] JUMP[MAIN1] NORM $; JUMP
.DEFINE SH2ND [ TYP DST1 DST2 DST3 ]
[TYP`PLS:	D[CONST 44] ALU[Q-D] COND[OBUS18] JUMP[DST3] C600 $
	D[CONST 44] ALU[Q-D] DEST[Q ROTR] JUMP[DST1] NORM $
TYP`NEG:	D[MASK 22] ROT[10] ALU[DORQ] DEST[Q ROTR] NORM $
TYP`NN1:	D[CONST 44] ALU[D+Q] DEST[Q ROTR] COND[-OBUS18] JUMP[TYP`DO] C600 $
	JUMP[DST2] NORM $
]

	.USE[AREA270]
	SH2ND [ROT ROTPLS ROTNN1 ROTDO]
ROTDO:	ACSEL[AC] ALU[AC] DEST[AR] SHORT $
	D[AR] ROT[R] ACSEL[AC] SPEC[MA_PC] DEST[AC MA] JUMP[MAIN1] NORM $
	SH2ND [LSH BIGLSH BIGLSH LSHPDO]

	.USE[AREA272]
BIGLSH:	ACSEL[AC] ALU[0] SPEC[MA_PC] DEST[AC MA] JUMP[MAIN1] NORM $

LSHPDO:	D[CONST 44] ALU[D-Q] DEST[MASKR] SHORT $
	D[2] MASK[R] ALU[D&AC] ACSEL[AC] DEST[AR] SHORT $
	D[AR] ROT[R] ACSEL[AC] DEST[AC MA] SPEC[MA_PC] JUMP[MAIN1] NORM $

LSHDO:	ALU[Q] DEST[MASKR] SHORT $
	ALU[AC] ACSEL[AC] DEST[AR] SHORT $
LSHDO1:	D[AR] MASK[R] ROT[R] SPEC[MA_PC] DEST[AC MA] ACSEL[AC] JUMP[MAIN1] NORM $
ASHDO1:	ALU[Q] DEST[MASKR] JUMP[LSHDO1] NORM $

	.USE[NORMAL]
	SH2ND [ASH BIGASH BIGAS2 ASHDOP]
BIGASH:	ALU[AC] ACSEL[AC] COND[OBUS=0] JUMP[MAIN] CYLEN[C450] $
	D[CONST 1] ROT[43] ACSEL[AC] ALU[D&AC] DEST[AC] SHORT $
	D[PC] DEST[Q] SHORT $
SETOV1:	D[CONST 1] ROT[43] ALU[DORQ] DEST[MA CRYOV] SPEC[MA_PC] NORM JUMP[MAIN1] $
ASHDO:	ACSEL[AC] ALU[AC] DEST[AR] COND[-OBUS<0] JUMP[ASHDO1] CYLEN[C500] $
	D[CONST 44] ALU[D-Q] DEST[MASKR] SHORT $
	D[2] MASK[R] ROT[R] DEST[Q] SHORT $
	D[AR] ROT[R] ALU[DORQ] SPEC[MA_PC] DEST[AC MA] ACSEL[AC] JUMP[MAIN1] NORM $
ASHDOP:	D[CONST 43] ALU[D-Q] DEST[MASKR] SHORT $
	ALU[Q] DEST[IR-ADR] SHORT $; SAVE SH AMT
	D[CONST 1] ROT[43] ACSEL[AC] ALU[D&AC] DEST[Q] SHORT $ ;GET SIGN BIT
	D[2] MASK[R] ACSEL[AC] ALU[D&AC] DEST[AR] SHORT $
	D[AR] ROT[R] ACSEL[AC] ALU[DORQ] DEST[O_AC AR] SHORT $
	D[IR] ALU[D+1] DEST[MASKR] SHORT $
	D[AR] ROT[R] DEST[Q] SHORT $
	D[2] MASK[R] ROT[43] ALU[D&Q] DEST[Q] COND[OBUS=0] JUMP[MAIN] C550 $
	D[2] MASK[R] ROT[43] ALU[D#Q] COND[OBUS=0] JUMP[MAIN] C550 $
	D[PC] DEST[Q] JUMP[SETOV1] NORM $
BIGAS2:	ACSEL[AC] ALU[AC] COND[-OBUS<0] JUMP[BIGLSH] CYLEN[C450] $
	ACSEL[AC] ALU[-1] DEST[AC MA] SPEC[MA_PC] JUMP[MAIN1] NORM $

ASHC1:	D[CONST 1] ROT[43] ALU[D&AC] ACSEL[AC] DEST[HOLD] NORM $ ; SAVE SIGN BIT
	D[IR] MASK[18.] COND[OBUS18] JUMP[ASHC2] C550 $
	D[IR] MASK[10] COND[OBUS=0] JUMP[MAIN] C550 $
	ALU[0] ACSEL[AC+1] DEST[AC] SHORT $
	D[IR] MASK[10] ALU[D-1] LLOAD NORM $
ASHC8:	ALU[SH-AC] DEST[D6] MASK[1] ACSEL[AC] NORM $
	ACSEL[AC] D[MEM] ALU[D#AC] COND[OBUS<0] JUMP[ASHC9] C550 $
ASHC6:	LOOP[ASHC8] NORM $
	D[PC] ACSEL[AC+1] ALU[DORAC] DEST[CRYOV] JUMP[ASHC7] NORM $
ASHC9:	D[CONST 1] ROT[43] ACSEL[AC+1] DEST[AC] JUMP[ASHC6] NORM $

.DEFINE SHLOOP [SHTYP DIR]
[	D[IR] MASK[10] ALU[D-1] LLOAD NORM $
	ALU[SH-AC] DEST[DIR] MASK[SHTYP] ACSEL[AC] LOOP[.] NORM $
]

ASHC4:	D[MEM] DEST[Q] SHORT $
	D[AR] ROT[43] MASK[43] ALU[DORQ] ACSEL[AC+1] DEST[AC] NORM $
	D[MASK 43] ACSEL[AC] ALU[D&AC] DEST[AC] SHORT $
	ACSEL[AC] ALU[QORAC] DEST[AC] JUMP[MAIN] NORM $
ASHC2:	D[IR] ALU[0-D] DEST[IR-ADR] NORM $
	SHLOOP [ 1 D4 ]
ASHC7:	ALU[Q] DEST[AR] JUMP[ASHC4] NORM $

	.USE[AREA274]
ROTC1:	D[IR] ALU[0-D] DEST[IR-ADR] JUMP[ROTC2] NORM $
	D[IR] COND[OBUS=0] MASK[10] JUMP[MAIN] C550 $
	SHLOOP[ 0 D6 ]
	ALU[Q] DEST[AC] ACSEL[AC+1] JUMP[MAIN] NORM $
ROTC2:	SHLOOP[ 0 D4 ]
	ALU[Q] DEST[AC] ACSEL[AC+1] JUMP[MAIN] NORM $

	.PAIR
LSHC1:	D[IR] MASK[18.] ALU[0-D] DEST[IR-ADR] JUMP[LSHC2] NORM $
	D[IR] MASK[10] COND[OBUS=0] JUMP[MAIN] C550 $
	SHLOOP [ 2 D6 ]
	ALU[Q] DEST[AC] ACSEL[AC+1] JUMP[MAIN] NORM $
	.USE[AREA272]
	debuguse = .		;See if it is still losing
: 2735	;%$@#&@# SLOEXP didn't redefine AREA272 properly!!! $*$*$*
LSHC2:	SHLOOP[ 2 D4 ]
	ALU[Q] DEST[AC] ACSEL[AC+1] JUMP[MAIN] NORM $

	.USE[AREA202]
SJMAIN:	ACSEL[MA] D[MEM] DEST[AC] $
	D[IR] DEST[MA PC] JUMP[MAIN1] $

	.USE[NORMAL]
PUSH1:	D[CONST 1,,1] ALU[D+AC] DEST[AC MA] COND[CRY0] JUMP[PDLO2] C600 $
	D[AR] DEST[MEMSTO] MEMSTMA $

POP1:	D[MEM] DEST[AR] SHORT $
	D[IR] MASK[18.] DEST[MA] SHORT $
	D[AR] DEST[MEMSTO] MEMST $

POPJ1:	D[MEM] MASK[18.] DEST[PC MA] JUMP[MAIN1] NORM $

PUSHJ1:	MAPF[MASTO] D[IR] MASK[18.] SPEC[CLR-HALF] DEST[PC] MEMST $


;BLTA2 BLT1 BLT7 BLT5 BLT3 BLT2 BLT9 BLT4 BLT6 BLT8 BLTA3 BLTL1 BLTA4 BLTA1 BLTAL2 BLTA10 BLTL2 BLTA12 ANDCA1 ANDCA2 ANDCA3 LOG2 LOG3 ORCM2 ORCM3
	.PAIR
BLTA2:	ACSEL[AC] ALU[AC] DEST[AR MA] JUMP[BLTA3] NORM $ ;SRC IS AC GET DEST ADR
BLT1:	D[PC] DEST[O_AC AR] ACSEL[AC] SHORT $
	D[AR] MASK[18.] DEST[Q PC] SHORT $
	D[IR] MASK[18.] ALU[D-Q] DEST[Q] LLOAD NORM $;GET COUNT
	ALU[Q] COND[OBUS<0] JUMP[BLT4] CYLEN[C450] $ ; J IF END PRECEDES STRT
BLT7:	D[AR] MASK[18.] ROT[18.] DEST[Q MA AR] SHORT $; FETCH FIRST WORD
BLT5:	DEST[FIXMAC-MAPF-RD] MAPF[BLT-RD] JUMP[BLT2] CYLEN[FIXM] $
BLT3:	DEST[FIXMAC-MAPF-RD] MAPF[BLT-RD] SPEC[PC+1] CYLEN[FIXM] $
BLT2:	D[MEM] SPEC[MA_PC] DEST[MEMSTO MA] COND[INTRPT] JUMP[BLT6] NORM $
	ALU[Q+1] DEST[Q AR MA] LOOP[BLT3] MAPF[BLT-WRT] CYLEN[MEMSTO] $
BLT9:	D[PC] MASK[18.] ACSEL[AC] DEST[O_AC PC] NORM $
	ACSEL[AC] D[IR] MASK[18.] ALU[AC-D] COND[-OBUS<0] JUMP[MAIN] C550 $ ;J IF DONE
	ACSEL[AC] ALU[AC+1] DEST[AC] SHORT $
	D[IR] ACSEL[AC] ALU[D-AC] LLOAD NORM $ ;GET COUNT
	D[PC] ACSEL[AC] DEST[O_AC PC] SHORT $
	ALU[Q] DEST[MA] JUMP[BLT5] NORM $
BLT4:	ALU[0] LLOAD NORM $
	JUMP[BLT7] NORM $
BLT6:	ALU[Q+1] DEST[Q AR] LOOP[BLT8] MAPF[BLT-WRT] CYLEN[MEMSTO] $
	JUMP[BLT9] $
BLT8:	ACSEL[AC] ALU[AC-1] DEST[AC] SPEC[PC+1] NORM $
	ACSEL[AC] D[PC] MASK[18.] DEST[O_AC PC] SHORT $
	D[AR] ROT[18.] SPEC[LEFT] ALU[DORAC] ACSEL[AC] DEST[AC] SHORT $
	DISP[2320] SPEC[PC+1-IF&] CYLEN[DISP] $
BLTA3:	D[AR] ROT[18.] DEST[AC-SEL] SHORT $ ;GET SRC ADR
	D[IR] MASK[18.] DEST[Q] SHORT $
	D[MA] MASK[18.] ALU[Q-D] DEST[Q] LLOAD NORM $
	ALU[Q] COND[OBUS<0] PUSHJ[BLTA4] CYLEN[C450] $
	D[AR] ROT[18.] MASK[18.] ALU[D+Q] DEST[Q] SHORT $
	D[MASK 30] ROT[4] ALU[D&Q] COND[-OBUS=0] JUMP[BLTA10] C550  $;J IF SRC LEAVES AC'S
BLTL1:	ACSEL[REG] ALU[AC] DEST[MEMSTO] NORM $
	D[MA] ALU[D+1] DEST[MA A-MEM-CNTR&INC] MAPF[BLT-WRTA] LOOP[BLTL1] CYLEN[MEMSTO] $
	SPEC[MA_PC] DEST[MA] JUMP[MAIN1] NORM $
BLTA4:	ALU[0] DEST[Q] LLOAD NORM $
	POPJ NORM $
BLTA1:	D[MASK 16] ROT[26] ACSEL[AC] ALU[D&AC] COND[OBUS=0] JUMP[BLTA10] C550 $; DEST IS AC, J IF SRC AC?
	D[IR] ROT[40] MASK[16] COND[-OBUS=0] JUMP[BLTA10] C550 $;J IF FINAL DEST NOT AC
	ACSEL[AC] ALU[AC] DEST[AR AC-SEL] SHORT $;GET DEST ADR
	D[IR] MASK[18.] DEST[Q] SHORT $
	D[AR] MASK[18.] ALU[Q-D] DEST[Q] LLOAD NORM $;GET COUNT
	ALU[Q] COND[OBUS<0] PUSHJ[BLTA4] CYLEN[C450] $;ADJUST IF CNT NEG.
	D[AR] ROT[18.] MASK[18.] DEST[MA] SHORT $;GET SRC ADR
BLTAL2:	DEST[FIXMAC-MAPF-RD AC] MAPF[BLT-RDA] D[MA] ALU[D+1] ACSEL[REG] CYLEN[FIXM] $
	ACSEL[REG] D[MEM] DEST[O_AC MA A-MEM-CNTR&INC] LOOP[BLTAL2] NORM $
	SPEC[MA_PC] DEST[MA] JUMP[MAIN1] NORM $
BLTA10:	ACSEL[AC] ALU[AC] DEST[AR] SHORT $
BLTL2:	D[AR] ROT[18.] MASK[18.] DEST[MA] SHORT $;GET WORD
	ACSEL[MA] ALU[AC] DEST[FIXMAC-MAPF-RD] MAPF[BLT-RDA] CYLEN[FIXM] $
	D[MEM] DEST[HOLD Q] SHORT $
	D[AR] MASK[18.] DEST[MA STRT-WRT] SHORT $
	MAPF[BLT-WRTA] COND[-MA-AC] JUMP[. + 2] C500 $
	ALU[Q] ACSEL[MA] DEST[AC] SHORT $
	D[AR] MASK[18.] DEST[Q] NORM $
	D[IR] MASK[18.] ALU[Q-D] MAPF[BLT-WRTA] COND[-OBUS<0] JUMP[MAIN] C600 $
	D[CONST 1,,1] DEST[Q]  NORM $
	D[AR] ALU[D+Q] DEST[AR] JUMP[BLTL2] NORM $;*** TEST FOR INTERRUPT HERE?
BLTA12:	MEMST $

	.USE[AREA276]

ANDCA1:	D[MEM] ACSEL[AC] ALU[D&Q] DEST[AC MA] SPEC[MA_PC] JUMP[MAIN1] NORM $

ANDCA2:	D[MEM] ALU[D&Q] DEST[MEMSTO] MEMST $

ANDCA3:	D[MEM] ACSEL[AC] ALU[D&Q] DEST[AC MEMSTO] MEMST $

LOG2:	ALU[NOTQ] DEST[MEMSTO] MEMST $

LOG3:	ACSEL[AC] ALU[NOTQ] DEST[AC MEMSTO] MEMST $

ORCM2:	ACSEL[AC] ALU[QORAC] DEST[MEMSTO] MEMST $

ORCM3:	ACSEL[AC] ALU[QORAC] DEST[AC MEMSTO] MEMST $

	.USE[NORMAL]
;SWINT NORSW NOSW RESW1 RESET RESET RESLOP DOHALT STPLOP STPLP1 NORSW2 RESW2 STRTSW CONSW DEPTSW DEPNSW DEPSW1 EXMTSW EXMNSW SETLTS EXMSW1 BRPNT MOVSS1 MOVNS1 HLLZS1 HRLZS1 HRRZS1 HLRZS1 HRAR HLAR HLLEM1 HRLEM1 HLREM1 HRREM1 HSMAIN HSMN1 HLLOS1 HRROS1 HLLES1 HRRES1 HLLES2 HMV HHS HLSZ HOR HRSZ HOL HRLM1 HLLM1 HLRM1 HRRM1 JRST1 JRST4 JRST5 JRST9 JRST8 JRST2 JRST3 JFCL1 JSR2 JSA1 JRA1 MUJSR MUJSP
;  MUJSA MUJSYS MUJSM1
;;;RESW1:
	.ORG[2062]	;*$*$* No REAL reason for this
: 2062	;SWITCH, AR & ECC INTERRUPTS COME HERE
SWINT:	DEST[CLR-DEV-FROM-INTR] SHORT $
	ALU[0] DEST[DEV-ADR] SPEC[IOB-IN] SHORT $
	D[IOD] DEST[AR] MAPF[4] CYLEN[IOB-IN] $ 		;GET SW BITS
	D[AR] ROT[7] MASK[1] COND[-OBUS=0] JUMP[APDINT] C550 $	;JUMP IF OVFL OR ECC INT
	D[CONST 15] ROT[1] DEST[Q] SPEC[IOB-OUT] SHORT $
	D[AR] ROT[14] ALU[D&Q] MAPF[4] COND[OBUS=0] JUMP[NOSW] C550 $	;CHECK FOR RELEVANT SW, & CLR FF.
	D[AR] ROT[10] MASK[1] COND[-OBUS=0] JUMP[RESW1] C550 $	;J IF RESET SW
NORSW:	D[AR] ROT[13] MASK[1] COND[-OBUS=0] PUSHJ[EXMTSW] C550 $	;PUSHJ IF EXAM THIS
	D[AR] ROT[11] MASK[1] COND[-OBUS=0] PUSHJ[DEPTSW] C550 $	;PUSHJ IF DEPO THIS
NOSW:	SPEC[MA_PC] DEST[MA] JUMP[MAIN1] NORM $

area206 = .	;Sigh...

	.RELOC

RESW1:	SPEC[IOB-IN] SHORT $
	D[IOD] DEST[AR]  CYLEN[IOB-IN] $	;DOUBLE CHECK RESET SW
	D[AR] ROT[10] MASK[1] COND[OBUS=0] JUMP[NORSW] CYLEN[C650] $	;DOUBLE CHECK RESET SW

;******* This code to be made a subroutine to allow machine resetting *******
;******* to be done by auto-loading and via CONO APR,20000  TVR-Mar80 *******

.REPEAT F2SW [
RESET:	D[CONST 0] DEST[IOD] SPEC[IOB-OUT] NORM $
  ]  ;END F2SW

.REPEAT 1 - F2SW [
RESET:	D[CONST 1] DEST[IOD] SPEC[IOB-OUT] NORM $
  ]  ;END 1 - F2SW
;*** Disable ECC interrupts on F3's?????

	MAPF[10] ALU[0] DEST[CRYOV] CYLEN[IOB-OUT] $	;CLR MAP-IN-USE & PC FLAGS & AR INT ENBL, ETC.
	DEST[CLR-MI-ERR] JUMP[RESLOP] NORM $
RESLOP:	ALU[0] DEST[HI-ABS-MA] NORM $
	DEST[CLR-DEV-FROM-INTR] $
	D[CONST 0] DEST[DEV-ADR] PUSHJ[APRRST] NORM $
	D[CONST 1] DEST[DEV-ADR] PUSHJ[MAPRST] NORM $
	D[CONST 4] DEST[DEV-ADR] PUSHJ[CTYRST] NORM $
	D[CONST 10] DEST[DEV-ADR] PUSHJ[DSKRST] NORM $
 .REPEAT WK [
	D[CONST 24] DEST[DEV-ADR] PUSHJ[WKRST] NORM $
    ]
	D[CONST 7] DEST[DEV-ADR] PUSHJ[TAPRST] NORM $
.REPEAT DLS [; 9 JAN 80  BO
	D[CONST DLSDEV] DEST[DEV-ADR] PUSHJ[DLSRST] NORM $
];DLS
.REPEAT VC [ ; 24 AUG 80  BO
	D[CONST VCDEV] DEST[DEV-ADR] PUSHJ[VCRST] NORM $
] ; VC
.REPEAT IMP [; 23JAN80 MLB
	D[CONST 16] DEST[DEV-ADR] PUSHJ[IMPRST] NORM $
];IMP
.REPEAT LPT [
.REPEAT STANSW [
	D[CONST 15] DEST[DEV-ADR] PUSHJ[LPTRST] NORM $
		;Hardware is trapping to wrong place!!!
];.REPEAT STANSW
	D[CONST 35] DEST[DEV-ADR] PUSHJ[LPTRST] NORM $
];LPT
.REPEAT STANSW [;Mar80 TVR
	D[CONST 30] DEST[DEV-ADR] PUSHJ[PANRST] NORM $
	D[CONST 30] DEST[DEV-ADR] PUSHJ[GRNRST] NORM $
];REPEAT STANSW
	D[CONST 6] DEST[DEV-ADR] PUSHJ[CLKRST] NORM $
	D[CONST 6] DEST[DEV-ADR] PUSHJ[TYMRST] NORM $
	D[CONST 6] DEST[DEV-ADR] PUSHJ[PI-RESET] NORM $
DOHALT:	DEST[CLR-DEV-FROM-INTR] NORM $
STPLOP:	D[CONST 1] DEST[DEV-ADR] SPEC[IOB-IN] NORM $
	MAPF[4] D[IOD] DEST[Q] CYLEN[IOB-IN] $
	ALU[0] DEST[DEV-ADR] SHORT $
	D[CONST 10] ALU[DORQ] DEST[IOD] SPEC[IOB-OUT] NORM $
	MAPF[10] CYLEN[IOB-OUT] $; SET PROG HALT LIGHT
	ALU[0] DEST[DEV-ADR MA] SPEC[MA_PC] NORM $
	FIXM1 SPEC[IOB-OUT] $
	D[MEM] MAPF[6] CYLEN[LONG] $
	SPEC[IOB-IN] NORM $
	D[IOD] DEST[AR] MAPF[4] CYLEN[IOB-IN] $
	D[AR] COND[OBUS<0] JUMP[BRPNT] C600 $; J IF BRK POINT SW
	SPEC[IOB-IN] NORM $
STPLP1:	D[IOD] DEST[AR] MAPF[4] CYLEN[IOB-IN] $	;GET SW BITS
	D[AR] ROT[10] MASK[1] COND[-OBUS=0] JUMP[RESW2] C550 $	;J IF RESET SW
	D[AR] ROT[14] MASK[11] DEST[Q] NORM $
	D[CONST 7] ROT[4] ALU[-D&Q] COND[OBUS=0] SPEC[IOB-IN] JUMP[STPLP1] C600 $; LOOP IF NO SW
	SPEC[IOB-OUT] NORM $
	MAPF[4] CYLEN[IOB-OUT] $    	;CLR SW FF'S
	.DEFINE SWTEST [ RAMT DIS ADR ]
[	D[AR] ROT[RAMT] MASK[1] COND[-OBUS=0] DIS [ ADR ] C550 $
]
NORSW2:	SWTEST[4 JUMP CONSW]
	SWTEST[5 JUMP STRTSW]
	SWTEST[11 PUSHJ DEPTSW]
	SWTEST[12 PUSHJ DEPNSW]
	SWTEST[13 PUSHJ EXMTSW]
	SWTEST[14 PUSHJ EXMNSW]
	D[CONST 0] DEST[DEV-ADR] SPEC[IOB-IN] JUMP[STPLP1] NORM $	;LOOP

RESW2:	SPEC[IOB-IN] SHORT $
	D[IOD] DEST[AR]  CYLEN[IOB-IN] $	;DOUBLE CHECK RESET SW
	D[AR] ROT[10] MASK[1] COND[OBUS=0] JUMP[NORSW2] CYLEN[IOB-IN] $	;DOUBLE CHECK RESET SW
	JUMP[RESET] NORM $
STRTSW:	D[AR] MASK[23] DEST[PC] NORM $
CONSW:	ALU[0] SPEC[MA_PC] DEST[MA HI-ABS-MA] NORM $
	D[CONST 1] DEST[DEV-ADR] SPEC[IOB-IN] NORM $
	MAPF[4] D[IOD] DEST[Q] CYLEN[IOB-IN] $
	ALU[0] DEST[DEV-ADR] NORM $
	D[CONST 7] ALU[D&Q] DEST[IOD] SPEC[IOB-OUT] NORM $
	MAPF[10] CYLEN[IOB-OUT] $; CLEAR PROG HALT LIGHT
	ACSEL[MA] ALU[AC] DEST[FIXMAC-MAPF-RD] MAPF[1] CYLEN[FIXM] $
	D[MEM] DEST[IR-ALL AR MA] DISP[2074] SPEC[PC+1-IF] CYLEN[DISP] $
        ; IGNORE STOP SW AND INTERRUPTS
DEPTSW:	D[AR] MASK[23] DEST[MA HI-ABS-MA] SPEC[IOB-IN] JUMP[DEPSW1] NORM $
DEPNSW:	D[MA] ALU[D+1] DEST[MA] NORM SPEC[IOB-IN] $
DEPSW1:	D[IOD] DEST[MEMSTO] MAPF[2] CYLEN[IOB-IN] $
	MAPF[TEMP] COND[-MA-AC] POPJ CYLEN[MEMSTO] $
	ACSEL[MA] D[MEM] DEST[AC] POPJ NORM $

EXMTSW:	D[AR] MASK[23] DEST[MA HI-ABS-MA] JUMP[EXMSW1] NORM $
EXMNSW:	D[MA] ALU[D+1] DEST[MA] JUMP[EXMSW1] NORM $
;NOTE: This subroutine is called by DATAO PI, which displays in the lights
SETLTS:	FIXM1 $			;Take page faults, if any.
EXMSW1:	ACSEL[MA] ALU[AC] DEST[FIXMAC-MAPF-RD] MAPF[TEMP] CYLEN[FIXM] $
	SPEC[IOB-OUT] NORM $
	D[MEM] MAPF[2] CYLEN[LONG] POPJ $
BRPNT:	D[AR] MASK[27] DEST[Q] NORM $
	D[PC] MASK[27] ALU[D-Q] COND[-OBUS=0] JUMP[CONSW] C600 $
	SPEC[IOB-IN] JUMP[STPLP1] NORM $

	.USE[AREA276]
MOVSS1:	D[MEM] ROT[18.] ACSEL[AC] DEST[AC MEMSTO] MEMST $

MOVNS1:	D[MEM] ALU[0-D] ACSEL[AC] DEST[AC MEMSTO] MEMST $

HLLZS1:	ACSEL[MA] D[MEM] COND[AC=0] DEST[AC AR MA] SPEC[LEFT&MA_PC] LBJUMP[HSMAIN] NORM $

HRLZS1:	ACSEL[MA] D[MEM] ROT[18.] COND[AC=0] DEST[AC AR MA] SPEC[LEFT&MA_PC] LBJUMP[HSMAIN] NORM $

HRRZS1:	ACSEL[MA] D[MEM] MASK[18.] COND[AC=0] DEST[AC AR MA] SPEC[MA_PC] LBJUMP[HSMAIN] NORM $

HLRZS1:	ACSEL[MA] D[MEM] ROT[18.] MASK[18.] COND[AC=0] DEST[AC AR MA] SPEC[MA_PC] LBJUMP[HSMAIN] NORM $

	.USE[AREA342]
HRAR:	D[AR] MASK[18.] ALU[DORAC] ACSEL[AC] DEST[AC MA] SPEC[MA_PC] JUMP[MAIN1] NORM $

HLAR:	D[AR] SPEC[LEFT&MA_PC] MASK[0] ALU[DORAC] ACSEL[AC] DEST[AC MA] JUMP[MAIN1] NORM $

HLLEM1:	D[AR] MASK[0] SPEC[LEFT] DEST[MEMSTO] MEMST $

HRLEM1:	D[AR] ROT[18.] MASK[0] SPEC[LEFT] DEST[MEMSTO] MEMST $

HLREM1:	D[AR] ROT[18.] MASK[18.] DEST[MEMSTO] MEMST $

HRREM1:	D[AR] MASK[18.] DEST[MEMSTO] MEMST $

	.USE[AREA344]
	.PAIR
HSMAIN:	ACSEL[AC] D[AR] DEST[AC] NORM $
	ACSEL[MA] ALU[AC] DEST[FIXMAC-MAPF-RD] MAPF[1] JPOP[MAIN2] NORM $
	.PAIR
HSMN1:	SPEC[MA_PC] DEST[MA] JUMP[MAIN1] CYLEN[MEMSTO] $
	D[MEM] ACSEL[AC] DEST[AC MA] SPEC[MA_PC] JUMP[MAIN1] CYLEN[MEMSTO] $
	.PAIR
HLLOS1:	D[MASK 22] ALU[DORQ] DEST[MEMSTO] MEMST $
	D[MASK 22] ALU[DORQ] DEST[MEMSTO AC] ACSEL[AC] MEMST $
	.PAIR
HRROS1:	D[MASK 22] ROT[18.] ALU[DORQ] DEST[MEMSTO] MEMST $
	D[MASK 22] ROT[18.] ALU[DORQ] DEST[MEMSTO AC] ACSEL[AC] MEMST $
	.PAIR
HLLES1:	D[MASK 22] ROT[18.] ALU[D&Q] DEST[Q] COND[-AC=0] LBJUMP[HLLES2] NORM $
	COND[-AC=0] LBJUMP[HLLOS1] NORM $
	.PAIR
HRRES1:	D[MASK 22] ALU[D&Q] DEST[Q] COND[-AC=0] LBJUMP[HLLES2] NORM $
	COND[-AC=0] LBJUMP[HRROS1] NORM $
	.USE[AREA346]
	.PAIR
HLLES2:	ALU[Q] DEST[MEMSTO] MEMST $
	ALU[Q] ACSEL[AC] DEST[MEMSTO AC] MEMST $
	.PAIR
HMV:	JUMP[MAIN] NORM $
	JUMP[MOVE] NORM $
	.PAIR
HHS:	D[AR] ROT[18.] ALU[DORQ] DEST[MEMSTO] MEMST $
	D[AR] ROT[18.] ALU[DORQ] ACSEL[AC] DEST[MEMSTO AC] MEMST $
	.USE[AREA352]
	.PAIR
HLSZ:	SPEC[MA_PC] DEST[MA] JUMP[MAIN1] NORM $
HOR:	D[MASK 22] ACSEL[AC] ALU[DORAC] SPEC[MA_PC] DEST[MA AC] JUMP[MAIN1] NORM $
	.PAIR
HRSZ:	SPEC[MA_PC] DEST[MA] JUMP[MAIN1] NORM $
HOL:	D[MASK 22] ACSEL[AC] ROT[18.] ALU[DORAC] SPEC[MA_PC] DEST[MA AC] JUMP[MAIN1] NORM $
	.PAIR
HRLM1:	D[AR] ROT[18.] DEST[Q] NORM $
HLLM1:	D[MEM] MASK[18.] ALU[DORQ] DEST[MEMSTO] MEMST $
	.PAIR	;(??) Added TVR-Apr80
HLRM1:	D[AR] ROT[18.] DEST[Q] NORM $
HRRM1:	D[MEM] MASK[0] SPEC[LEFT] ALU[DORQ] DEST[MEMSTO] MEMST $

	.USE[AREA350]
	.PAIR
JRST1:	;10 bit on in AC field
	COND[USER] JUMP[MUUO] NORM $; ILLEGAL IF USER MODE
	;10 bit off, or exec mode.  Check 2 bit.
	D[IR] ROT[14] MASK[1] COND[-OBUS=0] JUMP[JRST2] C550 $
JRST4:	;If 1 bit on in AC field, set user mode
	D[IR] ROT[15] MASK[1] COND[-OBUS=0] JUMP[JRST3] C550 $
JRST5:	;If 4 bit on in AC field, act like stop switch
	D[IR] ROT[13] MASK[1] COND[-OBUS=0] JUMP[JRST9] C550 $
	;If 10 bit on in AC field, dismiss
	D[IR] ROT[12] MASK[1] COND[-OBUS=0] JUMP[PI-DISMISS] C550 $
	JUMP[MAIN1] NORM SPEC[MA_PC] DEST[MA] $

	;4 bit on in AC field
JRST9:	COND[EXEC] JUMP[DOHALT] NORM $; HALT IF EXEC MODE
	MUUO1 $		;Halting in user mode is illegal

	;2 bit on in AC field
JRST2:	D[PC] DEST[Q] SHORT $
	 ;Flag restore.
	D[CONST 1] ROT[36] ALU[D&Q] DEST[Q] SHORT $
	 ;Don't let USER be cleared.
	D[AR] ALU[DORQ] DEST[Q] NORM $
	 ;Put in the new bits (but OR in the old USER)
	D[CONST 1] ROT[35. - 9.] ALU[-D&Q] DEST[CRYOV] JUMP[JRST4] NORM $
	 ;Don't let bit 9 be set (it is a sort of trap flag for PDL OV)

  .USE[AREA354]

	;1 bit on in AC field, set user mode
JRST3:	D[CONST 1] ROT[36] DEST[Q] SHORT $
	D[PC] ALU[DORQ] DEST[CRYOV] JUMP[JRST5] NORM $

JFCL1:	D[AR] ROT[40] ALU[D&Q] COND[OBUS=0] JUMP[MAIN] C550 $;TEST SELECTED FLAGS
	D[AR] ROT[40] ALU[-D&Q] DEST[CRYOV] SHORT $;CLEAR FLAGS
	DOJUMP $
JSR2:	D[MA] ALU[D+1] DEST[PC] SPEC[CLR-HALF] MAPF[STO] NORM $
	ACSEL[MA] D[MEM] DEST[AC MA] SPEC[MA_PC] JUMP[MAIN1] NORM $
JSA1:	D[MA] ALU[D+1] DEST[PC] SHORT $
	D[AR] DEST[MEMSTO] MEMST $
JRA1:	FIXM1 $
	ACSEL[AC] D[MEM] DEST[AC] CYLEN[FIXM+1] $
	D[IR] MASK[18.] DEST[PC MA] JUMP[MAIN1] NORM $

	.USE[NORMAL]
MUJSR:	D[MEM] DEST[IR-ALL MA] NORM $; GET INSTR.
	D[AR] DEST[MEMSTO] COND[MA-AC] JUMP[JSR2] NORM $
	D[MA] ALU[D+1] DEST[MA PC] MAPF[STO] SPEC[CLR-HALF] JUMP[MAIN1] CYLEN[MEMSTO] $
MUJSP:	D[MEM] DEST[IR-ALL MA] NORM $; GET INSTR.
	D[AR] ACSEL[AC] DEST[AC] JUMP[JSP1] NORM $
MUJSA:	D[MEM] DEST[IR-ALL MA] NORM $; GET INSTR.
	D[AR] ACSEL[AC] DEST[O_AC AR] JUMP[JSA1] NORM $
MUJSYS:	D[MEM] DEST[IR-ALL MA] SHORT $
	D[IR] ROT[33] MASK[11] COND[OBUS=0] JUMP[JSYS3] C550 $; J IF EX JSYS
MUJSM1:	ACSEL[MA] ALU[AC] DEST[FIXMAC-MAPF-RD] MAPF[MAPFTR] CYLEN[FIXM] $
	D[MEM] MASK[18.] DEST[PC] NORM $; JUMP TO RIGHT HALF
	D[MEM] ROT[18.] MASK[18.] DEST[MA] SHORT $; GET READY TO STORE
	D[AR] DEST[MEMSTO] MEMSTMA $

;CTYDSP AREA51 CTYINT CTYIOT CTYDI CTYDO CTYCO CTYCI CTYCI2 CTYCI1 CTYCI9 CTYCI8 CTYCI3 CTYCO1 CTYCO3 CTYCO4 CTYCO5 CTYRST ctyrs1 AREA52 CTYCZ CTYCS
;------------------------------------------------------------------------------
;
;	CTY - Console Teletype				Device 120
;
;------------------------------------------------------------------------------

;
;A-MEM Usage
;
CTY-DISP = 0		;Instruction and interrupt dispatch
CTY-CONT = 1		;Control bits for UART, etc.
CTY-STATUS = 2		;Firmware status

;
;*** Meanings of hardware bits should be documented here.
;
;MAPF values

.REPEAT NTP [
TTY.DI = 0	;read data
TTY.WD = 12	;write data
TTY.WC = 14	;write control
  ] ;NTP

.REPEAT OTP [
TTY.DI = 0	;read data
TTY.WD = 4	;write data
TTY.WC = 10	;write control
  ] ;OTP

;*$*$*	This ORG is ready to be flushed.  It only remains to test the code
;	and merge the AREAs

	.ORG[5100]	;CTY IOT DISPATCH TABLE

CTYDSP:	ILGIOT $	;BLKI
	NOP $
	D[CTY-STATUS + 10] DEST[Q] SPEC[IOB-IN] NORM $ ;DATAI
	MAPF[TTY.DI] D[IOD] DEST[AR] JUMP[CTYDI] CYLEN[IOB-IN] $
	ILGIOT $	;BLKO
	NOP $
	FIXM1 $		;DATAO
	D[CTY-STATUS + 10] DEST[Q] JUMP[CTYDO] NORM $ ; GET CONI BITS
	D[CTY-STATUS + 10] MASK[7] DEST[Q] NORM $ ;CONO, GET CONI BITS
	D[IR] MASK[7] ROT[40] ALU[-D&Q] DEST[Q] JUMP[CTYCO] NORM $ ;CLR THE CLR BITS
	D[CTY-STATUS + 10] DEST[Q] PUSHJ[CTYCI] NORM SPEC[IOB-IN] $
		; CONI, GET BITS
	D[AR] DEST[MEMSTO] MEMST $
	D[CTY-STATUS + 10] DEST[Q] PUSHJ[CTYCI] NORM SPEC[IOB-IN] $
		;CONSZ, GET BITS
	D[IR] MASK[18.] DEST[Q] JUMP[CTYCZ] NORM $
	D[CTY-STATUS + 10] DEST[Q] PUSHJ[CTYCI] NORM SPEC[IOB-IN] $
		;CONSO, GET CONI BITS
	D[IR] MASK[18.] DEST[Q] JUMP[CTYCS] NORM $
;$*$*$ We may not be able to afford this in the future...  TVR-Apr80
LPTDSP:
.REPEAT 1 - LPT [
     .REPEAT 10 [ILGIOT $
	NOP $
];.REPEAT 10
];.REPEAT 1 - LPT

.REPEAT LPT [		;Allocate space for LPT dispatch
:. + 20
];.REPEAT LPT

AREA51:	;$*$*$ Start code from here for now.  This should go away


: 2130 ;CTY and 60 HZ CLOCK INTS COME HERE

CTYINT:
  .REPEAT NTP [;With new tape controller, 60HZ clk shares DEV 4 w/ CTY.
	START-IN SHORT $
	MAPF[5] D[IOD] ALU[NOTD] DEST[AR] C600 $
		;Read the NET interface status...
	D[AR] MASK[1] C550 -OBUS=0 JUMP[CLKINT] $
		;Is 60HZ clk requesting an int. ? Jump if so.
	NORM JUMP[CTYIN1] $
		;Else it is the CTY's turn.
: 2144
      ] ;NTP

CTYIN1:	D[CTY-STATUS + 10] DEST[Q] PUSHJ[CTYCI] NORM SPEC[IOB-IN] $
		; DO A CONI, GET BITS
	D[CTY-CONT + 10] MASK[11] DEST[IOD] SPEC[IOB-OUT] NORM $; DISABLE INTS
	MAPF[TTY.WC] CYLEN[IOB-OUT] D[CTY-STATUS + 10] MASK[3] DEST[Q AR] $
		; GET PI CHAN
	NORM  DEST[CLR-DEV-FROM-INTR] JUMP[PIGEN] $;CAUSE INTR.

;$*$*$ This one is referenced off the MAP dispatch
AREA52 = 5210

.USE[AREA52]

	.PAIR
	UIOTRP[MUUO] $
CTYIOT:	IOTDIS [51]

CTYDI:	D[CONST 40] ALU[-D&Q] DEST-A-MEM DEST[CTY-STATUS] NORM $; CLR TTI FLAG
	D[CONST 10] ROT[3] DEST[Q] SHORT $
	D[CTY-CONT + 10] ALU[DORQ] DEST[IOD] SPEC[IOB-OUT] SHORT $;CLR RCV. CHR
	MAPF[TTY.WC]  CYLEN[IOB-OUT] $
	D[CTY-CONT + 10] DEST[IOD] SPEC[IOB-OUT] SHORT $
	MAPF[TTY.WC] CYLEN[IOB-OUT] $
	D[AR] MASK[10] DEST[MEMSTO] MEMST $
CTYDO:	D[MEM] DEST[IOD] SPEC[IOB-OUT] NORM $;SEND CHR.
	MAPF[TTY.WD] CYLEN[IOB-OUT] D[CONST 10] ALU[-D&Q] DEST[Q] $;CLR TTO FLAG
	D[CTY-CONT + 10] ALU[D+1] DEST[IOD] SPEC[IOB-OUT] NORM $
		;ENABLE UART STB
	MAPF[TTY.WC] CYLEN[IOB-OUT]
			D[CONST 20] ALU[DORQ] DEST[CTY-STATUS] DEST-A-MEM $
		;SET TTO BUSY
	D[CTY-CONT + 10] DEST[IOD] SPEC[IOB-OUT] NORM $;CLR UART STB
	MAPF[TTY.WC] CYLEN[IOB-OUT] D[CONST 7] ALU[D&Q] COND[OBUS=0] JUMP[MAIN] $ ; DONE IF NO PI CHAN
	D[CTY-CONT + 10] DEST[Q] SHORT $; GET IOB-OUT BITS
	D[CONST 4] ROT[11] ALU[DORQ] DEST[Q IOD] SPEC[IOB-OUT] NORM $ ;ENABLE XMT INT
	MAPF[TTY.WC] CYLEN[IOB-OUT] ALU[Q] DEST[CTY-CONT] DEST-A-MEM JUMP[MAIN] $
CTYCO:	D[CONST 17] ROT[3] ALU[D&Q] DEST[Q] NORM $;CLR PI BITS
	D[IR] MASK[7] ALU[DORQ] DEST[CTY-STATUS] DEST-A-MEM JUMP[CTYCO1] NORM $
		;OR IN NEW PI BITS
CTYCI:	MAPF[TTY.DI] D[IOD] DEST[HOLD] CYLEN[IOB-IN] $;GET UART BITS
	D[CTY-CONT + 10] DEST[IOD] SPEC[IOB-OUT] NORM $
	MAPF[TTY.WC] D[MEM] ROT[26] MASK[1] COND[-OBUS=0] JUMP[CTYCI1] CYLEN[MAX,IOB-OUT,C550] $; J IF RCV RDY
CTYCI2:	D[CONST 10] ROT[3] ALU[-D&Q] DEST[Q AR] JUMP[CTYCI9] NORM $;CLR TTI BUSY
CTYCI1:	D[CONST 40] ALU[D&Q] COND[-OBUS=0] JUMP[CTYCI2] C550 $;J IF TTI FLAG ON
	D[CONST 10] ROT[3] ALU[D#Q] DEST[Q AR] NORM $;COMPL BUSY.
	D[CONST 10] ROT[3] ALU[D&Q] COND[-OBUS=0] JUMP[CTYCI9] C550 $;J IF BUSY NOW ON
	D[CONST 40] ALU[DORQ] DEST[Q AR] NORM $; SET TTI FLAG
CTYCI9:	D[MEM] ROT[25] MASK[1] COND[-OBUS=0] JUMP[CTYCI8] C550 $;J IF XMT RDY
	D[CONST 20] ALU[DORQ] DEST[CTY-STATUS] DEST-A-MEM POPJ NORM $
		;SET BUSY -- NOTE, NO "AR DEST" IS CORRECT
CTYCI8:	D[CONST 20] ALU[D&Q] COND[OBUS=0] JUMP[CTYCI3] C550 $; J IF BUSY OFF
	D[CONST 10] ALU[DORQ] DEST[Q] NORM $; SET FLAG
CTYCI3:	D[CONST 20] ALU[-D&Q] DEST[CTY-STATUS] DEST-A-MEM POPJ NORM $ ;CLR BUSY
CTYCO1:	D[IR] ROT[41] MASK[10] DEST[Q] NORM $; GET SET&CLR BITS
	D[CONST 10] ROT[3] ALU[D&Q] COND[OBUS=0] JUMP[CTYCO4] $
		; J IF CLR TTI FLAG OFF
	D[CTY-CONT + 10] MASK[11] DEST[Q] NORM $;GET IOB-OUT BITS
	D[CONST 10] ROT[3] ALU[DORQ] DEST[IOD] SPEC[IOB-OUT] NORM $
		;GET CLR RCV RDY BIT
CTYCO3:	MAPF[TTY.WC] CYLEN[IOB-OUT] $
	ALU[Q] DEST[IOD] SPEC[IOB-OUT] NORM $;CLR IT
	MAPF[TTY.WC] CYLEN[IOB-OUT] $
CTYCO4:	D[CTY-CONT + 10] MASK[11] DEST[Q] NORM $; GET IOB-OUT BITS
	D[CTY-STATUS + 10] MASK[3] COND[OBUS=0] JUMP[CTYCO5] C550 $
		; J IF NO PI CHAN
	D[CONST 2] ROT[11] ALU[DORQ] DEST[Q] SHORT $; ENBL RCV INT
	D[CTY-STATUS + 10] ROT[41] MASK[2] COND[OBUS=0] JUMP[CTYCO5] C550 $
		; J IF NO OUT FLAG OR BUSY
	D[CONST 4] ROT[11] ALU[DORQ] DEST[Q] SHORT $;ENBL XMT INT
CTYCO5:	ALU[Q] DEST[IOD] SPEC[IOB-OUT] SHORT $; FIX INT ENBLS
	MAPF[TTY.WC] CYLEN[IOB-OUT] ALU[Q] DEST[CTY-CONT] DEST-A-MEM JUMP[MAIN] $
; **** HERE IS DEFN. OF CTY UART CONSTANTS ****

CTYRST:	D[CONST 4] DEST[DEV-ADR] NORM $
	D[CONST 4] ROT[6] DEST[Q CLR-DEV-FROM-INTR] NORM $
	D[CONST 74] ALU[DORQ] DEST[Q CTY-CONT] DEST-A-MEM NORM $
	D[CONST 3] ROT[6] ALU[DORQ] DEST[IOD] SPEC[IOB-OUT] NORM $; RESET UART
	MAPF[TTY.WC] CYLEN[IOB-OUT] ALU[0] DEST[CTY-STATUS] DEST-A-MEM $
	ALU[Q] DEST[IOD] SPEC[IOB-OUT] NORM JUMP[CTYRS1] $

    .USE[AREA356] 	;$*$*$*$ Temporary ****

CTYRS1:
;Setup entry vectors: IOT vector in left half, interrupt vector in right half	
	MAPF[TTY.WC] C800 D[CONST (CTYDSP / 100)] ROT[18. + 6.] DEST[Q] $
		;High order 6 IOT bits
	D[CONST (CTYDSP \ 100)] ROT[18.] ALU[DORQ] DEST[Q] NORM $
		;Low order 6 IOT bits
	D[CONST (CTYINT / 100)] ROT[6.] ALU[DORQ] DEST[Q] NORM $
		;High order 6 interrupt bits
	D[CONST (CTYINT \ 100)] ROT[0] ALU[DORQ]
			SPEC[DEST-A-MEM] DEST[CTY-DISP] POPJ NORM $
		;Low order 6 interrupt bits
		;Finish setting up vectors and return.


;;;	.USE[AREA206]
;;;	debuguse = .

;;;:2074	;%$#@#$% SLOEXP didn't redefine AREA206 properly??? $*$*$*$

	.USE[NORMAL]

	.PAIR
CTYCZ:	D[AR] ALU[D&Q] COND[-OBUS=0] JUMP[MAIN] C550 $
	DOSKIP $
CTYCS:	D[AR] ALU[D&Q] COND[OBUS=0] JUMP[MAIN] C550 $
	DOSKIP $

;$*$*$ This code should set up dispatch and interrupt vectors.  It will have to
;      be moved to the end of regular disk stuff.  TVR-Apr80
DSKRST:	ALU[0] DEST[IOD] SPEC[IOB-OUT] NORM $
	  ;SET DSK CTRL COMMAND REGISTER TO 0 (DISABLES INTS).
	MAPF[4] D[CONST 2] DEST[IOD] SPEC[IOB-OUT]
				CYLEN[IOB-OUT] $
	  ;NOW RESET THE CONTROLLER.
	MAPF[7] ALU[0] DEST[1] DEST-A-MEM  CYLEN[IOB-OUT]  POPJ $
	  ;ALSO CLEAR THE PI CHANNEL ASSIGNMENT.

SET-DSK-OUT:
	D[CONST 10] DEST[DEV-ADR] NORM COND[-USER] JUMP[SDSKO2] $
	UIOTRP[MUUO] $
		;Watch for IOT-USER mode.
SDSKO2:	D[MEM] DEST[IOD AR] SPEC[IOB-OUT] NORM POPJ $

;Kludge to allow disk controller status IOTs from IOT-USER Mode.  This is
;so a wizard can look at the state of the disk controller from MDDT (or UEDDT).
UDSKST:	UIOTRP[MUUO] $
		;Ignore SPEC[IOB-IN] we just did and trap if in user mode.
	D[IR] ROT[8 + 1 + 1] MASK[10.] DEST[Q] $
		;Extract opcode
	D[CONST 1] ALU[DORQ] DEST[Q] $
		;Skip first micro instruction that got us here
	D[CONST 2] ROT[9.] ALU[DORQ] SDISP CYLEN[DISP] SPEC[IOB-IN] $
		;Dispatch again to finish instruction

;$*$*$ This code should set up dispatch and interrupt vectors.  It will have to
;      be moved to the end of regular disk stuff.  TVR-Apr80
TYMRST:		;RESET TYMNET INTERFACE
	D[CONST 1] DEST[Q] PUSHJ[DEV6CL] NORM $
.REPEAT TYMNET [
	JUMP[TYMRS1] NORM $	;SET INITIAL COROUTINE ADR, INT ENBLS.
];TYMNET
.REPEAT 1 - tymnet [
	POPJ NORM $
]; 1 - tymnet

;$*$*$ This code should set up dispatch and interrupt vectors.  TVR-Apr80

 .REPEAT OTP [

CLKRST:	  ;RESET 60HZ CLOCK FLAG AND DISABLE ITS INTERRUPTS.
	D[CONST 1] ALU[NOTD] DEST[Q] PUSHJ[DEV6CL] NORM $
		;LOAD A MASK INTO Q AND GO TO COMMON ROUTINE.
	;FALLS IN
CLKCLR:	  ;CLEAR 60HZ CLOCK FLAG.
	D[CONST 6] DEST[DEV-ADR] SPEC[IOB-OUT] NORM $
	MAPF[10] CYLEN[IOB-OUT]  ;THIS CLEARS THE FLAG.
	 D[10 + APRSTS] SPEC[A-MEM-APR] ROT[32] MASK[1] DEST[AR] $
	  ;GET THE APR CONDITIONS WD.
	D[CONST 1] ALU[NOTD] DEST[Q] JUMP[DEV6ST] NORM $
	 ;SET OR CLEAR THE HARDWARE INTRPT. ENB. ACCORDING TO
	 ; STATE OF CLK INT ENB BIT IN APR 
  ] ;OTP

 .REPEAT NTP [

CLKRST:		;Fall in to CLKCLR
CLKCLR:	START-OUT D[CONST 4] DEST[DEV-ADR] NORM $
		;Clear clk flag.
CLKENB:	MAPF[7] D[12] SPEC[A-MEM-APR] ROT[26.] DEST[IOD] C600 $
	  	;Get the APR conditions wd, put CLK INT ENB bit in bit 35.
	START-OUT NORM $
	MAPF[6] C600 POPJ $
	 	;SET OR CLEAR THE HARDWARE INTRPT. ENB. ACCORDING TO
	 	; STATE OF CLK INT ENB BIT IN APR 
  ] ;NTP

.REPEAT OTP [  ;Tape and Timer interact only with old tape ctrl...

TAPRST:	 ;RESET THE TAPE CONTROLLER AND ASSOCIATED DEVICES.

	D[CONST 7] DEST[DEV-ADR] NORM $ ;SELECT DEVICE.
;;	ALU[0] DEST[] DEST-A-MEM NORM $
		;Set tape mode to CORE-DUMP
   .REPEAT KNYTAPE [ PUSHJ[KNYRST] $ 
			;Clear KENNEDY formatter, if any. ]

   	D[CONST 1] ROT[35.] DEST[Q] NORM $	;

   .REPEAT TIMER [  ;IF INTERVAL TIMER IS PRESENT...
	D[CONST 1] ROT[35. - 19.] ALU[DORQ] DEST[Q 1] DEST-A-MEM $
	   ;FORM DATA TO CLR TAPE ERR FF'S, ENABLE TIMER INTRPTS
     ] ;TIMER
   .REPEAT 1 - TIMER [  ;IF INTERVAL TIMER IS ABSENT...
	ALU[Q] DEST[Q 1] DEST-A-MEM $
	   ;FORM DATA TO CLR TAPE ERR FF'S, DISABLE TIMER INTRPTS
     ] ;1 - TIMER

	START-OUT D[CONST 1] ROT[35. - 6] ALU[DORQ] DEST[IOD] NORM $
	   ;DO SO;  ALSO CLEAR TIMER OVERFLOW INTRPT FLAG.
	MAPF[1] START-OUT D[CONST 1] ROT[35. - 9] DEST[Q IOD] C800 $
	   ;ALSO CLEAR ALL SIGNALS TO THE DEVICE, SET "CLOCK RUN"
	MAPF[6] ALU[Q] DEST[2] DEST-A-MEM  C800 $
	   ;RECORD THE "CLOCK RUN" BIT IN A-MEM[2]; EVERYONE WHO
	   ; LOADS THE CTL REG (MAPF[4]) SHOULD INCLUDE IT.
	D[CONST 60] ROT[35. - 15.] DEST[Q] NORM $
	D[CONST 30] ROT[35. - 21.] ALU[DORQ] DEST[Q] NORM $
	   ;ASSEMBLE -1000. AS 12-BIT NO. ENDING AT BIT 21.
	START-OUT D[CONST 41] ROT[35. - 7] ALU[DORQ] DEST[IOD] NORM $
	   ;THIS SETS TIMER CLOCK FOR 100 USEC TICKS, ZEROES COUNTER.
	MAPF[1] ALU[0] DEST[3] DEST-A-MEM C800 POPJ $
	   ;INIT THE TIMER REG. TO 0 AND RETURN.
   ] ;OTP

;$*$*$*$* This should be moved to CFKNYD.SLO   TVR-Sep80
  .REPEAT NTP [

TAPRST:	 ;RESET THE TAPE CONTROLLER.
	D[CONST 7] DEST[DEV-ADR] NORM $ ;SELECT DEVICE.
	START-OUT ALU[0]  DEST[IOD] $
	 ;Turn off "FORMATTER ENABLE"
	MAPF[2] LONG $
	  ;Fall in to TIMRST.

TIMRST:	D[CONST 5] DEST[DEV-ADR] NORM $
	START-OUT D[CONST TIMER] DEST[IOD] NORM $
		;Enable timer interrupts if TIMER is 1, else disable them.
	MAPF[10] ALU[0] DEST[1] DEST-A-MEM C600 $
		;Clear pi channel
	ALU[0] DEST[3] DEST-A-MEM NORM POPJ $
		;Clear timer reg.
   ] ;NTP

APRRST:
.REPEAT F2SW [
	ALU[0] DEST[IOD] SPEC[IOB-OUT] NORM $	;Clear Addr. Break
];REPEAT F2SW
	MAPF[1] ALU[0] DEST[APRSTS] SPEC[A-MEM-APR&DEST-A-MEM] CYLEN[IOB-OUT] POPJ $
;$*$*$ This code should set up dispatch and interrupt vectors.  TVR-Apr80

CLRDEVINT:	   DEST[CLR-DEV-FROM-INTR] POPJ NORM $
		;CLEAR FLAG WHICH CAUSES DEV-ADR TO BE
		; ADR OF LAST INTERRUPTING DEVICE,
		; SO THE DEV-ADR REGISTER WILL WORK AGAIN.

;------------------------------------------------------------------------------
;
;	PI - Priority Interrupt Service			Device 4
;
;------------------------------------------------------------------------------

;PI SYSTEM USE OF APR AMEM---
; 4	MEM PAR ERR(BIT 19), MEM PAR ERR INTRPT ENB(BIT 20),
;	 PI SYSTEM ON(BIT 28) CHN1-7 ON (BITS 29-35)
; 5	WAITING RQ 1-7 (11-18)  IN PROG 1-7 (29-35)
; 6	RQ COUNTS - 4-BIT FIELDS, CHN. 7 AT RIGHT END OF WORD.
;
;Other uses of APR AMEM are documented at the beginning 

PI-GET-CHN:	;MAKE BINARY CHN. NO. FROM MASK IN AR.
	D[AR] ROT[34] DEST[AR] NORM $
		;PUT RQ 1 INTO BIT 1
	D[CONST 6] DEST[MA] NORM $
		;MA WILL GET 7-CHN (FOR USE IN SHIFTING)
PIL1:	D[AR] ROT[1] DEST[AR] C550
	   COND[OBUS<0] JUMP[PIGETMASK] $ ;FOUND FIRST BIT ?
	D[MA] ALU[D-1] DEST[MA] NORM JUMP[PIL1] $
		;NO. DECREMENT COUNT AND LOOP.
PIGETMASK:	D[MA] DEST[ROTR] NORM $ ;LOAD ROTATE AMT.
	D[CONST 1] ROT[R] DEST[AR] NORM 
	  POPJ $	;MAKE MASK OF FIRST BIT ONLY IN AR.


PI-CHECK-RQS:	 ;SEE IF IT IS TIME TO TAKE AN INTRPT.
.REPEAT STANSW [	;Determine which PI channels should be enabled for PAN
	D[14] SPEC[A-MEM-APR] ROT[35. - 10.] DEST[Q] PUSHJ[PANIST] NORM $
		;Select only those channels turned on and readyt to interrupt
	MAPF[PAN-INT-ENB] CYLEN[IOB-OUT] 
	 D[15] SPEC[A-MEM-APR] ROT[18.] MASK[7] DEST[AR]
	 COND[OBUS=0] JUMP[MAIN] $ ;ANY RQ'S ?
];.REPEAT STANSW
.REPEAT 1 - STANSW [
	D[15] SPEC[A-MEM-APR] ROT[18.] MASK[7] DEST[AR]
	  C550 COND[OBUS=0] JUMP[MAIN] $ ;ANY RQ'S ?
];.REPEAT 1 -STANSW
	ALU[0] DEST[DEV-ADR] NORM PUSHJ[PI-GET-CHN] $
		;GET UNARY CHN NO. IN AR, SHIFT AMT. IN MA, ROTR
	D[14] ROT[34] C550 COND[-OBUS<0] JUMP[MAIN] $
		;EXIT IF PI SYS NOT ON.
	D[MASK 7] ROT[R] DEST[Q] NORM $
		;MASK OF CHN AND ALL HIGHER CHNS.
	D[15] ALU[D&Q] C550 COND[-OBUS=0] JUMP[MAIN] $
		;EXIT IF THIS OR HIGHER CHN IN PROGRESS.
	D[AR] DEST[Q] NORM $ ;MOVE UNARY CHN # TO Q.
	D[14] ALU[D&Q] C550 COND[OBUS=0] JUMP[MAIN] $
		;EXIT IF CHN NOT ON.
	D[MA] ROT[2] DEST[ROTR] NORM $
		;GET SHIFT AMT 4 TIMES LARGER, TO ACCESS CNT FIELD
	D[CONST 1] ROT[R] DEST[Q] NORM $
		;A ONE ALIGNED WITH RQ CNT FIELD FOR THIS CHN.
	D[16] ALU[D-Q] DEST[Q HOLD] NORM $
		;DECREMENT OUR WAITING RQ COUNT.
	D[16] ALU[D#Q] DEST[Q] NORM $ ;DID WE OVERFLOW ?
	D[CONST 20] ROT[R] ALU[D&Q] COND[-OBUS=0] C550 JUMP[.] $
	  ;LOOP HERE FOREVER IF WE OVERFLOWED 4-BIT CNT FIELD
	D[MEM] DEST[6 Q] DEST-A-MEM NORM $
		;PUT BACK WORD OF RQ COUNTS.
	D[CONST 17] ROT[R] ALU[D&Q] C550
	  COND[-OBUS=0] JUMP[PIINTGO] $ ;JUMP IF OUR COUNT NEQ 0
	D[AR] ROT[18.] ALU[NOTD] DEST[Q] NORM JUMP[PIL11] $
		;MASK FOR CLEARING THE WAITING RQ BIT.
PIINTGO:	D[CONST 0] ALU[NOTD] DEST[Q] NORM $
		;DON'T CLEAR THE BIT, RQ'S STILL WAITING
PIL11:	D[15] ALU[D&Q] DEST[Q] NORM $
		;GET STATUS B, EITHER DO OR DO NOT CLEAR RQ BIT
	D[AR] ALU[DORQ] DEST[5] DEST-A-MEM NORM $
		;SET IN PROGRESS BIT, STORE STATUS B.
	D[PC] DEST[Q AR] NORM $ ;GET PC INTO Q, AR.
	D[MASK 43] ROT[37] ALU[D&Q] DEST[CRYOV] NORM $ ;CLR USR MODE

;;;	D[MA] ROT[18.] ALU[DORQ] DEST[1] DEST-A-MEM NORM $
;;; This is an obsolete bug trap -- DWP 9/80

 ;; FOLLOWING INSTR. IS DEBUGGING AID
	D[CONST 56] DEST[Q] NORM $
		;PREPARE TO CALC. INTRPT. ADDRESS.
	D[MA] ROT[1] ALU[Q-D] DEST[MA] NORM JUMP[PIMUUO] $
		;FETCH INTRPT. INSTR AND GO INTERPRET IT.
PIGEN:	 ;ENTER WITH CHN IN AR TO REQUEST INTRPT.
	ALU[0] DEST[DEV-ADR] NORM PUSHJ[CLRDEVINT] $
	D[14] DEST[Q] NORM $
	D[CONST 1] ROT[18.] ALU[D+Q] DEST[4] DEST-A-MEM
		NORM $
	D[CONST 7] DEST[Q] NORM $
		;7-CHN IS AMT TO SHIFT BY FOR MASK BIT.
	D[AR] MASK[3] ALU[Q-D] DEST[MA] NORM
	  PUSHJ[PIGETMASK] $ ;LOAD ROTR, FORM MASK IN AR
PIGEN1:	D[14] ROT[34] C550 COND[-OBUS<0] JUMP[PIGENWT] $
		;BRANCH IF PI SYS NOT ON.
	MASK[7] D[2] ROT[R] DEST[Q] NORM $
		;MASK OF CHN AND ALL HIGHER CHNS.
	D[15] ALU[D&Q] C550 COND[-OBUS=0] JUMP[PIGENWT] $
		;BRANCH IF THIS OR HIGHER CHN IN PROGRESS.
	D[AR] DEST[Q] NORM $ ;MOVE UNARY CHN # TO Q.
	D[14] ALU[D&Q] C550 COND[-OBUS=0] JUMP[PIINTGO] $
		;IF CHN ON, GO TAKE INTRPT.
PIGENWT:	  ;INTRPT CANNOT HAPPEN NOW, SO SET A WAITING RQ.
	D[MA] ROT[2] DEST[ROTR] NORM $
		;GET SHIFT AMT 4 TIMES LARGER, TO GET CNT FIELD
	D[CONST 1] ROT[R] DEST[Q] NORM $
		;A ONE ALIGNED WITH RQ CNT FIELD FOR THIS CHN.
	D[16] ALU[D+Q] DEST[Q HOLD] NORM $
		;INCREMENT OUR WAITING RQ COUNT.
	D[CONST 10] ROT[R] ALU[D&Q] COND[-OBUS=0] C550 JUMP[. + 2] $
	  ;DON'T LET COUNT GET HIGHER THAN 7.
	D[MEM] DEST[6] DEST-A-MEM NORM $
		;PUT BACK WORD OF RQ COUNTS.
	D[15] DEST[Q] NORM $
		;GET STATUS B.
	D[AR] ROT[18.] ALU[DORQ] DEST[5] DEST-A-MEM
	   NORM JUMP[MAIN] $ ;SET WAITING RQ BIT.

PI-DISMISS:
	D[15] SPEC[A-MEM-APR] MASK[7] DEST[AR]
	  C550 COND[-OBUS=0] PUSHJ[PI-GET-CHN] $
	D[15] SPEC[A-MEM-APR] DEST[Q] NORM $
	D[AR] ALU[-D&Q] DEST[5] SPEC[A-MEM-APR&DEST-A-MEM]
		NORM JUMP[PI-CHECK-RQS] $
PICONO:  ;Here from any CONO PI,
	D[MA] MASK[7]  DEST[AR] NORM $
	ALU[0] DEST[DEV-ADR] NORM $
	D[14]  DEST[Q] NORM $ ;GET STATUS A
	D[MA] ROT[21.]  C550 COND[-OBUS<0] JUMP[PIL7] $
	D[CONST 1] ROT[35. - 20.] ALU[DORQ] DEST[Q] NORM $ 
	 ; TURN ON PAR ERR INTRPT ENB.
PIL7:	D[MA] ROT[20.]  C550 COND[-OBUS<0] JUMP[PIL8] $
	D[CONST 1] ROT[35. - 20.] ALU[-D&Q] DEST[Q] NORM $ 
	 ;TURN OFF PAR ERR INT ENB
PIL8:	D[MA] ROT[19.] C550 COND[-OBUS<0] JUMP[PIL9] $
	D[CONST 1] ROT[35. - 19.] ALU[-D&Q] DEST[Q] NORM $ 
	 ;CLEAR MEM PAR ERR FLAG
PIL9:	D[MA] ROT[5]  C550 COND[OBUS18] PUSHJ[PI-RESET] $
	D[MA] ROT[12]  C550 COND[-OBUS18] JUMP[PIL3] $
	D[CONST 1] ROT[7] ALU[DORQ] DEST[Q] NORM $ ; PI ON
PIL3:	D[MA] ROT[11]  C550 COND[-OBUS18] JUMP[PIL4] $
	D[CONST 1] ROT[7] ALU[-D&Q] DEST[Q] NORM $ ; PI OFF
PIL4:	D[MA] ROT[7]  C550 COND[-OBUS18] JUMP[PIL5] $
	D[AR] ALU[DORQ] DEST[Q] NORM $ ; CHNS ON
PIL5:	D[MA] ROT[10]  C550 COND[-OBUS18] JUMP[PIL6] $
	D[AR] ALU[-D&Q] DEST[Q] NORM $ ; CHNS OFF
PIL6:	ALU[Q] DEST[4] DEST-A-MEM NORM $
	D[MA] ROT[6]  C550 COND[-OBUS18] JUMP[PI-CHECK-RQS] $
	D[AR] MASK[7] ALU[0-D] DEST[Q] NORM $
		;GENERATED INTRPTS REQUESTED. CHECK TO
		; MAKE SURE ONLY ONE CHN IS SPECIFIED.
	D[AR] MASK[7] ALU[D&Q] DEST[Q] NORM $
	D[AR] MASK[7] ALU[D-Q] C600
	  COND[-OBUS=0] JUMP[.] $ ;HANG HERE IF MORE THAN ONE.
	D[AR] MASK[7]  DEST[AR] NORM PUSHJ[PI-GET-CHN] $
		;GET BINARY CHN. NUMBER AND UNARY MASK.
	NORM JUMP[PIGEN1] $ ;GO GENERATE REQUEST.


PICONISUB:
	D[14] SPEC[A-MEM-APR] MASK[18.] DEST[Q] NORM $
	  ;GET SYS ON AND CHN ON BITS.
	D[15] SPEC[A-MEM-APR] MASK[10] DEST[AR] NORM $
	  ;GET PI IN PROG BITS
	D[AR] ROT[10] ALU[DORQ] DEST[AR Q] NORM $
	D[15] SPEC[A-MEM-APR] ROT[18.] MASK[10] DEST[AR] NORM $
	  ;GET WAITING RQ BITS, AND RETURN IN LEFT HALF.
	D[AR] ROT[18.] ALU[DORQ] DEST[AR Q] NORM POPJ $

PI-RESET:
	ALU[0] DEST[4] SPEC[A-MEM-APR&DEST-A-MEM] NORM $
	ALU[0] DEST[5] SPEC[A-MEM-APR&DEST-A-MEM] NORM $
	ALU[0] DEST[6 Q] SPEC[A-MEM-APR&DEST-A-MEM] NORM POPJ $

;;;	ALU[0] DEST[1] SPEC[A-MEM-APR&DEST-A-MEM] NORM POPJ $
;;; This is an obsolete bug trap -- DWP 9/80

END-OF-PI-CODE:
;; MBOOT MOVED TO PAGE WITH REST OF TAPE STUFF

;MAPIOT MAPIO1 MAPCO0 MAPCOB MAPCOC MFT1 MFT1A MFT1D MFRD MFOTH MBLT3 SETHLF QORCRY SETHFU BWRTA1 MBLT2 MAPCWT MAPCW1 MAPCW2
;------------------------------------------------------------------------------
;
; 	BBN Pager - Map CONO Dispatch Table
;
;*** What these things do should documented here.  It's hard enough to find it
;*** elsewhere!  TVR-Apr80
;
;	This code is all BBN dependent.  It will be replaced for other pagers.
;
;------------------------------------------------------------------------------

	.ORG[5200]	;$*$*$ This should be fixed

	JUMP[MAPCO0] NORM $		  ;CONO 0
	DEST[CLR-MAP] JUMP[MAPCO1] NORM $ ;CONO 1 -- START MAP CLEARING
	UAOP1 $				  ;CONO 2 -- Ill. Instruction
	DEST[CLR-MAP] JUMP[MAPCO1] NORM $ ;CONO 3 -- START MAP CLR
	D[CONST 1] DEST[DEV-ADR] JUMP[MAPCO4] NORM $; CONO 4
	D[CONST 1] DEST[DEV-ADR] JUMP[MAPCO4] NORM $; CONO 5
	JUMP[MAPCO6] NORM $		  ;CONO 6
	DEST[CLR-MAP] JUMP[MAPCO7] NORM $ ;CONO 7

	.USE[AREA51]
			;$*$*$	This is truely silly.  The CTY code appears
			;	after the map dispatch and the map code
			;	after the CTY dispatch!
	.PAIR
	UIOTRP[MUUO] $
MAPIOT:	D[IR] ROT[9.] COND[-OBUS<0] JUMP[MAIN] C550 $ ;NOP IF DEV. 20
	D[CONST 14] ALU[D#Q] COND[OBUS=0] JUMP[MAPIO1] C550 $; IS IT CONO ?
	D[CONST 13] ALU[D#Q] COND[OBUS=0] JUMP[MAPDO] C550 $; NO IS IT DATAO?
	ILGIOT $   ;ELSE ILLEGAL
MAPIO1:	D[IR] MASK[3] DEST[Q] NORM $
	D[CONST 52] ROT[6] ALU[DORQ] SDISP C600 $
MAPCO0:	D[CONST 1] DEST[DEV-ADR] PUSHJ[MAPCOA] NORM $
	D[12] DEST[Q] NORM $
		; GET SIGN BIT = ENBL FOR EXEC 0-77777
	ALU[0] DEST[DEV-ADR] SHORT $
	D[IR] MASK[2] DEST[IOD] SPEC[IOB-OUT] SHORT $
	MAPF[10] CYLEN[IOB-OUT] DEST[CLR-MAP] D[CONST 20] LLOAD $
		; TURN OFF MAPPING & START CLEARING MAP
	LOOP [.] C550 $  ;WAIT FOR MAP CLR TO FINISH -- OTHERWISE THE
	  	; READS OF 71 AND 72 BELOW DON'T HAPPEN (ON F2 #1).
.REPEAT 1 - WAITS [
   ;Now add 1 to abs. loc. 31 of main mem (for statistics keeping)
;;;;	D[CONST 32] DEST[MA] NORM PUSHJ[MPINC1] $
    ];.REPEAT 1 - WAITS
  	D[CONST 71] DEST[MA] SHORT $; FETCH MAGIC LOC
	D[CONST 1] DEST[DEV-ADR] CYLEN[FIXM]  $; WAIT FOR DATA
	D[MEM] MASK[13] DEST[AR] SHORT $
	D[AR] ROT[11] DEST-A-MEM DEST[4] NORM $; MBR
	D[MEM] ROT[18.] MASK[13] DEST[AR] SHORT $
	D[AR] ROT[11] DEST-A-MEM DEST[1] NORM $; UBR
.REPEAT 1 - WAITS [
	D[MEM] ROT[27] MASK[5] DEST[AR] SHORT $
	D[AR] ROT[4] DEST-A-MEM DEST[3] NORM $; AC BASE REG
];.REPEAT 1 - WAITS
	D[MEM] ROT[7] MASK[3] ALU[0-D] DEST[AR] 
		COND[OBUS=0] JUMP[MAPCOB] C600 $; ADDRS LIMIT, J IF 0
	D[AR] MASK[3] DEST[AR] SHORT $
	D[AR] ROT[16] DEST[AR] JUMP[MAPCOC] NORM $
		; FORM SMALLEST ILLEGAL ADDRESS
MAPCOB:	D[CONST 20] ROT[16] DEST[AR] SHORT $
MAPCOC:	D[CONST 1] ROT[43] ALU[D&Q] DEST[Q] SHORT $
		; GET SIGN BIT = ENBL FOR EXEC 0-77777
	D[AR] ALU[DORQ] DEST-A-MEM DEST[AR 2] NORM $; ADDRS LIMIT
.REPEAT WAITS [
	D[11] DEST[HI-ABS-MA MA] SHORT $
		;Fetch first location of user page table
	D[MEM] MASK[13] DEST[3] DEST-A-MEM LONG $
		;Wait for memory to finish, then save page table entry.
];.REPEAT WAITS
	D[CONST 72] DEST[MA] SHORT $; GET NEXT WORD
	D[MEM] DEST[Q] LONG $	;LONG to wait for data to arrive.
	D[CONST 1] ROT[32] ALU[-D&Q] DEST-A-MEM DEST[5] JUMP[MAPCOE] NORM $
		; AGE & PROCESS BITS

;------------------------------------------------------------------------------
;
;	MAP FAULT DISPATCHES COME HERE (6100 + MAPF*4 )
;
;	MAP traps happen on next micro instruction after a MEMSTO or STRT-WRT.
;	They also happen after micro instruction containing a DEST[FIXMAC...],
;	as in FIXM1 for example.  The trap happens by forcing an unconditional
;	jump to an address determined by MAP-DISP register and the MAPF of
;	field of the failing micro instruction.  Otherwise, that micro
;	instruction is executed normally.
;	
;	This code should be the same for all kinds of maps.  However, it will
;	be necessary to define symbolically the trap code, i.e. the thing that
;	is usually being loaded left half of Q.  After doing that, and updating
;	necessary state of PC and flags, the code leave by jumping to MFT1B,
;	the map dependent page fault/page fill code, with fault code in Q and
;	failing address in the MA.
;
; ***	As you will notice, there are NO spare trap codes.  If you need one,
; ***	talk to me about a scheme for fixing this and improving page fault
; ***	recovery.  TVR-Apr80
;
;------------------------------------------------------------------------------
	.ORG[6100]	;Fixed by hardware to xx100
	JUMP[.] $   ;ILLEGAL MAP FAULT -- MICROCODE BUG IF YOU GET HERE
.REPEAT XUCODE [
:16100	;copy for high mem
	JUMP[6100] $
];XUCODE
	;**** Consider looking at STOP switch in the future.	TVR - Mar80
	;
	;To find out non-destructively how you lost, start at 2003 (on an F2)
	;you will be stopped at PC+1, assuming you lose trying to display
	;that instruction in the lights (i.e. (PC) not mapped in)
	;
	;You can get here by examining/depositing a location in the
	;hardware map (i.e. it may only be asking for a page-fill cycle).
: 6104	;EXECUTE (&INDIRECT) FAULTS HERE
MFT1:	D[CONST 2] ROT[18.] DEST[Q] NORM $; CODE FOR EXECUTE
MFT1A:	D[CONST 1] DEST[DEV-ADR] NORM $
MFT1D:	DEST[CLR-DEV-FROM-INTR] SPEC[IOB-IN] SHORT $
	D[IOD] MASK[3] DEST[AR IR-ADR] JUMP[MFT1B] MAPF[4] CYLEN[IOB-IN] $
: 6110	;NORMAL READ FAULT
MFRD:	D[CONST 10] ROT[18.] DEST[Q] NORM $;CODE FOR RD
MFOTH:	D[PC] ALU[D-1] DEST[PC] JUMP[MFT1A] NORM $
.REPEAT XUCODE [
:16110	;NORMAL READ FAULT -High mem duplicate instr.
	D[CONST 10] ROT[18.] DEST[Q] NORM $;CODE FOR RD
];XUCODE
: 6114	;RMW HERE, DECREMENTS PC
	D[CONST 14] ROT[18.] DEST[Q] JUMP[MFOTH] NORM $
.REPEAT XUCODE [
:16114	;RMW -High mem duplicate instr.
	D[CONST 14] ROT[18.] DEST[Q] JUMP[MFOTH] NORM $
];XUCODE
: 6120	;WRITES (NORMAL) HERE (NO DECREMENT PC)
	D[CONST 4] ROT[18.] DEST[Q CLR-DEV-FROM-INTR] NORM $
	D[CONST 1] DEST[DEV-ADR] NORM $
	D[AR] DEST-A-MEM DEST[7] NORM $;SAVE STORE DATA
	D[IR] MASK[18.] DEST[MA] NORM JUMP[MFT1D] $; RESTORE MA
.REPEAT XUCODE * VID [
: 16124 ; 5-- BLT-RD IN HIGH MEM (DPY-RD)
;;;	JUMP[DPYRD] NORM $
];XUCODE * VID
: 6124 ; 5-- BLT-RD
	D[PC] MASK[18.] ACSEL[AC] DEST[O_AC PC] NORM $; RESTORE PC & DEST ADR
	D[CONST 10] ROT[18.] DEST[Q] SHORT $; CODE FOR RD
MBLT3:	D[AR] ROT[18.] SPEC[LEFT] ALU[DORAC] ACSEL[AC] DEST[AC] JUMP[MFOTH] NORM $; GET SRC ADR
.REPEAT XUCODE * VID [
: 16130 ; 6-- BLT-WRT IN HIGH MEM (DPY-WRT)
;;;	JUMP[DPYWRT] NORM $
];XUCODE * VID
: 6130 ;6-- BLT-WRT
	D[PC] MASK[18.] ACSEL[AC] DEST[O_AC PC MA] SPEC[MA_PC] NORM $; RESTORE PC, GET DEST ADR
	ALU[Q-1] DEST[AR] NORM $;  ADJUST SRC ADR
	D[CONST 4] ROT[18.] DEST[Q] JUMP[MBLT3] NORM $; CODE FOR WRT
: 6134 ;7-- BLT-RDA
	ACSEL[AC] D[AR] DEST[AC] NORM $; NEW DEST ADR
	D[CONST 10] ROT[18.] DEST[Q] JUMP[MFOTH] NORM $; CODE FOR RD
: 6140 ; 10-- BLT-WRTA
	D[CONST 4] ROT[18.] DEST[Q CLR-DEV-FROM-INTR] NORM $; CODE FOR WRT
	D[MA] MASK[18.] DEST[Q] PUSHJ[BWRTA1] NORM $; GET MA, SAVE STORE DAT
	D[AR] MASK[18.] ALU[D#Q] COND[OBUS=0] JUMP[MBLT2] C550 $
	ALU[Q-1] DEST[Q MA] JUMP[MBLT2] NORM $; CORRECT MA
: 6144 ;11-- BYTE-ILD
	PUSHJ[SETHLF] NORM $; SET HALF
	JUMP[6110] NORM $; NORMAL READ
;Page fault in the middle of a interruptable instruction.  Set HALF (BIS)
;flag as part of page fault processing so that instruction gets restarts in
;the proper way.
SETHLF:	D[CONST 2] ROT[36] DEST[Q] COND[USER] JUMP[SETHFU] NORM $;BIT 4--HALF
		;Get ready to set HALF (BIS) flag.
		;Watch for special case of User page fault from Exec. TVR-May80
QORCRY:	D[PC] ALU[DORQ] DEST[CRYOV] POPJ NORM $;SET HALF
: 6150 ;12 -- BYTE-IDP
	PUSHJ[SETHLF] NORM $; SET HALF
	JUMP[6114] NORM $;NORMAL RMW
;When a DEST[CRYOV] is done, the EXEC shift register is cleared (set) to
;whatever the user bit in the new CRYOV is.  This destroys the information
;about which space a page fault came from on XCTR (XCT mapped) instruction.
;We turn it on explicitly here.  Note that since a user cannot do a XCTR,
;we only have to worry about the case of being in EXEC mode and getting a
;user mode page fault.	TVR-May80
SETHFU:	D[PC] ALU[DORQ] DEST[CRYOV] NORM $
		;Set the half flag.
		;Don't return yet, we need to reset EXEC-SR
	SET-TEMP-USER POPJ $
		;Remember that the page fault was from a user page!!
: 6154 ;13 -- BYTE-IND
	PUSHJ[SETHLF] NORM $; SET HALF
	JUMP[6104] NORM $; NORMAL INDIRECT
: 6160 ;BLT-WRTB -- XCT MAPPED BLT STORES
	D[CONST 4] ROT[18.] DEST[Q CLR-DEV-FROM-INTR] NORM $; CODE FOR WRT
	D[MA] MASK[18.] DEST[Q] PUSHJ[BWRTA1] NORM $; GET MA, SAVE STORE DAT
	D[CONST 4] ROT[18.] DEST[Q] NORM $
	D[AR] ACSEL[AC] DEST[AC] JUMP[MFOTH] NORM $; RESTORE AC
: 6164 ;-- MAPFTR -- TRAP WHIILE FETCHING JSYS TARGET
	D[CONST 50] ROT[18.] DEST[Q CLR-DEV-FROM-INTR] NORM $; PI CODE
	D[CONST 1] DEST[DEV-ADR] NORM $
	D[AR] DEST-A-MEM DEST[7] JUMP[MFOTH] NORM $
: 6170 ;PPOP-- 16 -- POP & POPJ FETCH- RE-INCR PDL PNTR -- THEN LIKE READ FAULT
	D[CONST 1,,1] ACSEL[AC] ALU[D+AC] DEST[AC] JUMP[MFRD] NORM $

: 16174  ;UPPER MEM COPY OF 6174
	D[CONST 4] ROT[18.] DEST[Q CLR-DEV-FROM-INTR] NORM $
: 6174 ;17-- WRITES WITH RELEVANT ADRS IN MA (NO DECR PC)
	D[CONST 4] ROT[18.] DEST[Q CLR-DEV-FROM-INTR] NORM $
	D[CONST 1] DEST[DEV-ADR] SHORT $
	D[MEM] DEST-A-MEM DEST[7] JUMP[MFT1D] NORM $;SAVE STORE DATA
BWRTA1:	D[CONST 1] DEST[DEV-ADR] NORM $
	D[MEM] DEST-A-MEM DEST[7] POPJ NORM $
MBLT2:	D[AR] MASK[18.] ALU[Q-D] DEST[Q] SHORT $; COUNT HOW MANY WORDS MOVED
	D[AR] ROT[18.] ALU[Q+D] DEST[AR] SHORT $;FORM NEW SRC
	ACSEL[AC] D[MA] MASK[18.] DEST[AC] SHORT $;NEW DEST
	D[CONST 4] ROT[18.] DEST[Q] NORM $
	D[AR] ACSEL[AC] ROT[18.] SPEC[LEFT] ALU[DORAC] DEST[AC] JUMP[MFOTH] NORM $; OR IN NEW SRC

OTHER = .	;$*$*$ This is the end of the fix areas, In'Sh'Allah  TVR-Apr80

: 5340	;$*$*$ The APR dispatch ends at 5340.

;*$*$* Fudge area accounting
AREA53 = .

.USE[AREA53]

MAPCWT:	ALU[Q] LLOAD NORM $
	LOOP[.] CYLEN[LONG] $; WAIT FOR MAP TO CLEAR
	D[CONST 4] DEST[IOD] SPEC[IOB-OUT] SHORT $;TURN ON MAP
	MAPF[10] D[AR] COND[OBUS<0] JUMP[MAPCW9] CYLEN[MAX,IOB-OUT,C550] $
		; JUMP IF WHOLE MAP ON (INCLUDING EXEC 0-77777)- DONE
MAPCW1:	D[CONST 77]  MAPF[10] LLOAD NORM $
MAPCW2:	D[PC]  DEST[AR] SHORT $;SAVE FLAGS
	ALU[0] DEST[MA CRYOV] SHORT $;INIT MA, SET EXEC
	D[CONST 10] ROT[6]  DEST[Q] SHORT $

 .REPEAT NEWMAP [
	D[CONST 1] DEST[DEV-ADR] NORM $ ; -- FOR WRITING MAP
	SPEC[IOB-OUT] SHORT $  ;SET FIRST PART OF 
	   ; EXEC MAP TO POINT TO "NULL MAP" LOCS(UNMAPPED)
 	MAPF[2] D[MA] MASK[18.] C800 $ ;MAP DATA COMES FROM OBUS.
	D[MA] ALU[D+Q] DEST[MA] LOOP[. - 2] NORM $;LOOP
   ] ; NEWMAP

 .REPEAT 1 - NEWMAP [
	D[MA] MASK[18.] DEST[STO-MAP] NORM $
	  ;SET FIRST PART OF EXEC MAP TO POINT TO "NULL MAP" LOCS(UNMAPPED)
	D[MA] ALU[D+Q] DEST[MA] LOOP[. - 1] NORM $;LOOP
  ] ; 1 - NEWMAP

	D[IR] MASK[3]  DEST[IOD] SPEC[IOB-OUT] SHORT $; RESTORE MAP
	D[AR]  DEST[CRYOV] JUMP[MAIN] MAPF[10] CYLEN[IOB-OUT] $; RESTORE FLAGS, DONE
;------------------------------------------------------------------------------
;	End map trap code which is common to all maps.
;------------------------------------------------------------------------------
;MAPCOA MAPCOE MAPCO1 MAPCOG MAPCO4 MPOFF1 MAPOFF MAPCO6 MAPCO7 MAPCW9 MAPDO MFUS MFA3 MFA7 MFA6 MFA4 MFT1B MFHIEX MFA1 MFA2 MFB3 MFTYP1 MFTYP0
;------------------------------------------------------------------------------
;	BBN MAP CONO, continued
;
;	This code will need to be rewritten for another kind of map.
;
;------------------------------------------------------------------------------
MAPCOA:
	DEST[CLR-DEV-FROM-INTR] SPEC[IOB-IN] SHORT $
	D[IOD]  MASK[3] DEST[IR-ADR] MAPF[4] POPJ CYLEN[IOB-IN] $
		;GET MAP, ECC & OV ENBL BITS
MAPCOE:	ALU[0] DEST[DEV-ADR] SHORT $
	D[IR] MASK[3] DEST[IOD] SPEC[IOB-OUT] NORM $
		; RESTORE MAP STATE
	MAPF[10] D[CONST 1] DEST[Q] JUMP[MAPCWT] CYLEN[IOB-OUT] $

MAPCO1:	D[CONST 1] DEST[DEV-ADR] PUSHJ[MAPCOA] NORM $
		;GET ENABLE BITS IN IR
	D[12] DEST[AR] NORM $
		; GET SIGN BIT = ENBL EXEC 0-77777
 .REPEAT NEWMAP [
   .REPEAT 1 - WAITS [
   ;Now add 1 to abs. loc. 32 of main mem (for statistics keeping)
;;;;	ALU[-1] DEST[MAP-DISABLE] NORM $
;;;;	D[CONST 32] DEST[MA] NORM PUSHJ[MPINC1] $
    ];.REPEAT 1 - WAITS
  ] ;NEWMAP
ALU[0] DEST[DEV-ADR] SHORT $
	D[CONST 5] DEST[Q] JUMP[MAPCWT] NORM $

MAPCOG:	D[CONST 1] DEST[DEV-ADR] NORM $
	D[12] MASK[43] DEST[Q] NORM $
	D[IR] MASK[1] DEST[AR] SHORT $
		;GET LOW BIT OF CONO
	D[AR] ROT[43] ALU[DORQ] DEST-A-MEM DEST[2] NORM $
		;GET SIGN BIT = EXEC 0-77777 MAP ENBL
	SPEC[IOB-IN] SHORT $
	MAPF[4] D[IOD] MASK[3] DEST[Q] CYLEN[IOB-IN] $
	ALU[0] DEST[DEV-ADR] SHORT $
	D[CONST 4] ALU[DORQ] DEST[IOD] SPEC[IOB-OUT] SHORT $
	D[CONST 4] ALU[DORQ] DEST[IR-ADR] MAPF[10] POPJ CYLEN[IOB-OUT] $
		;TURN ON MAP
MAPCO4:	DEST[CLR-DEV-FROM-INTR] SPEC[IOB-IN] NORM PUSHJ[MAPOFF] $

MPOFF1:	MAPF[10] CYLEN[IOB-OUT] JUMP[MAIN] $
		; DONE
MAPOFF:	D[IOD] MASK[3] DEST[IR-ADR] MAPF[4] CYLEN[IOB-IN] $
	ALU[0] DEST[DEV-ADR] SHORT $
	D[IR] MASK[2] DEST[IOD] SPEC[IOB-OUT] NORM POPJ $

MAPCO6:	DEST[CLR-DEV-FROM-INTR] PUSHJ[MAPCOG] NORM $
	JUMP[MAPCW1] NORM $
MAPCO7:	DEST[CLR-DEV-FROM-INTR] PUSHJ[MAPCOG] CYLEN[LONG] $
	CYLEN[LONG] $; WAIT FOR MAP TO CLEAR
	CYLEN[LONG] $
MAPCW9:	ALU[0] LLOAD NORM $; SET UP ONLY PAGE 0
	JUMP[MAPCW2] NORM $

;------------------------------------------------------------------------------
;DATAO CLEARS THE "ASSOCIATIVE" REGISTER MAPPING THE ADDRESS OF THE DATAO
; THIS REPLACES CONO 2.
;------------------------------------------------------------------------------
MAPDO:	D[CONST 1] DEST[DEV-ADR] PUSHJ[MAPCOA] NORM $;GET MAP BITS
 .REPEAT 1 - NEWMAP [ ALU[0] DEST[DEV-ADR] NORM $ ]
	D[CONST 4] DEST[IOD] SPEC[IOB-OUT] SHORT $;TURN ON MAP
	MAPF[10] CYLEN[IOB-OUT] $
 .REPEAT NEWMAP [
	SPEC[IOB-OUT] SHORT $  ;REQUEST MAP WRITE CYCLE.
	MAPF[2] D[CONST 1] ROT[32] C800 $ ]

 .REPEAT 1 - NEWMAP [
	D[CONST 1] ROT[32] DEST[STO-MAP] NORM $ ]
	  ;CLR MAP ENTRY ASSOCIATED WITH MA
	D[IR] MASK[3] DEST[IOD] SPEC[IOB-OUT] C800 $; RESTORE ENABLES
	MAPF[10] CYLEN[IOB-OUT] JUMP[MAIN] $

;------------------------------------------------------------------------------
;
;	BBN MAP - Handle map trap and page fill cycles.
;
;	This code will need to be rewritten for another kind of map.
;
;------------------------------------------------------------------------------
MFUS:	D[12] MASK[40] DEST[Q] NORM $;GET LIMIT REG
	D[MA] ALU[D-Q] COND[-OBUS<0] JUMP[MTRPAL] C600 $;J IF MA PAST ADDRS LIMIT
	D[11] DEST[Q] JUMP[MFA1] NORM $;GET USER BASE REG.

MFA3:	D[MEM] ROT[12] MASK[1] COND[-OBUS=0] JUMP[MFA4] C550 $ ;J IF MODIF. BIT ON
MFA7:	D[AR] DEST[IR-ALL] SHORT $; SAVE ORRIGINAL MA
	D[AR] DEST-A-MEM DEST[6] NORM $; SAVE TRAP WORD
	D[CONST 1] ROT[27] ALU[DORQ] DEST[AR] SHORT $; TURN ON WRT-PREVENT, SAVE NEW MAP WORD
MFA6:	D[MEM] MASK[33] DEST[Q] JUMP[MFA5] NORM $; GET CST ENTRY, GO DO
MFA4:	D[IR] ROT[26] MASK[1] COND[OBUS=0] JUMP[MFA7] C550 $; J IF NO WRT-PERMIT
	D[AR] DEST[IR-ALL] SHORT $; SAVE ORRIGINAL MA
	D[AR] DEST-A-MEM DEST[6] NORM $; SAVE TRAP WORD
	D[MASK 43] ROT[30] ALU[D&Q] DEST[AR] JUMP[MFA6] NORM $; CLEAR WRT-PREVENT
;------------------------------------------------------------------------------
; Enter here with fault code in Q and address in MA to handle page fault or
; page fill cycle.  MAP-EXEC-SR (i.e. USER condition) is still undisturbed.
;------------------------------------------------------------------------------
MFT1B:	D[MA] MASK[18.] ALU[DORQ] DEST[AR] COND[USER] JUMP[MFUS] NORM $;GET FAILED ADDRS, J IF USER
	D[MA] ROT[24] MASK[2] DEST[Q] NORM $; HIGH ORDER 2 BITS
	D[CONST 3] ALU[D-Q] COND[OBUS=0] JUMP[MFHIEX] C600 $; J IF PRIVATELY MAPPED PART
	D[CONST 30] ROT[6] DEST[Q] JUMP[MFA1] NORM $; PAGE TAB @ 3000
MFHIEX:	D[14] DEST[Q] NORM $
MFA1:	ALU[0] DEST[DEV-ADR] NORM $
	D[IR] MASK[2] DEST[IOD] SPEC[IOB-OUT] NORM $ ;CLEAR MAPPING
	D[IR] MASK[3] DEST-A-MEM DEST[APRENB] MAPF[10] CYLEN[IOB-OUT] $
		;SAVE AR, ECC INT
	D[MA] ROT[33] MASK[11] ALU[D+Q] DEST[MA HI-ABS-MA] NORM $; FETCH PAGE TABLE ENTRY
	D[CONST 16] ROT[14] DEST[IR-ADR] NORM $; PREPARE INITIAL PERMIT BITS
	D[CONST 1] DEST[DEV-ADR] NORM $
MFA2:	D[CONST 3] DEST[Q] CYLEN[FIXM] $; DON'T CLEAR IND PNTR. COUNT, WAIT FOR FETCH
	D[MEM] ROT[18.] ALU[DORQ] DEST[Q] CYLEN[FIXM+1] $;GET PERMIT BITS
	D[IR] ALU[D&Q] DEST[IR-ADR] SHORT $; AND THEM IN
	D[MEM] ROT[13] MASK[3] COND[-OBUS=0] JUMP[MFTR1] C550 $; CHECK FOR TRAP BITS
MFB3:	D[MEM] ROT[15] MASK[1] COND[OBUS=0] JUMP[MFTR2] C550 $; J IF NO ACCESS PERMIT
	D[MEM] ROT[2] MASK[2] DEST[Q] COND[OBUS=0] JUMP[MFTYP0] C550 $; GET TYPE CODE, J IF 0
	ALU[Q-1] DEST[Q] COND[OBUS=0] JUMP[MFTYP1] C550 $; J IF 1
	ALU[Q-1] DEST[Q] COND[-OBUS=0] JUMP[MFTR3] C550 $; J IF NOT 2
	D[IR] ROT[43] MASK[1] COND[-OBUS=0] JUMP[MFTR41] C550 $; TYPE 2, J IF >2 INDR. PNTRS
	D[IR] ALU[D+1] DEST[IR-ADR] SHORT $; COUNT IND. PNTRS
	D[MEM] ROT[33] MASK[15] DEST[Q] SHORT $; GET PAGE TABLE #
	D[MEM] DEST-A-MEM DEST[6] NORM $; SAVE PNTR
	D[CONST 2] ROT[14] ALU[D+Q] DEST[MA HI-ABS-MA] NORM $; FETCH PAGE TABLE PNTR
	D[16] MASK[11] DEST[Q] CYLEN[FIXM] $; GET PAGE #, WAIT FOR MEM
	D[MEM] ROT[18.] MASK[4] COND[-OBUS=0] JUMP[MFTR4] C550 $; PAGE OUT-OF-CORE?
	D[MEM] MASK[13] DEST[HOLD] NORM $
	D[MEM] ROT[11] ALU[DORQ] DEST[MA HI-ABS-MA] JUMP[MFA2] NORM $; LOOP
MFTYP1:	D[MEM] ROT[33] MASK[15] DEST[Q] SHORT $; GET SHARED PAGE #
	D[CONST 2] ROT[14] ALU[D+Q] DEST[MA HI-ABS-MA] NORM $; FETCH SHARED PNTR
MFTYP0:	D[CONST 12] ROT[14] DEST[Q] CYLEN[FIXM] $; GET R-X MASK
	D[IR] ALU[D&Q] COND[OBUS=0] JUMP[. + 2] C600 $; J IF NEITHER R NOR X
	D[IR] ALU[DORQ] DEST[IR-ADR] NORM $; TURN ON R AND X
	D[IR] ROT[27] MASK[3] ALU[NOTD] DEST[Q] CYLEN[FIXM] $; GET RWX ENBL BITS, INVERTED
	D[MEM] ROT[18.] MASK[4] COND[-OBUS=0] JUMP[MFTR5] CYLEN [C550] $; J IF OUT-OF-CORE
	D[AR] ROT[21] MASK[3] ALU[D&Q] DEST[Q] COND[-OBUS=0] JUMP[MFTR6] C550 $; J IF ILLEGAL ACCESS TYPE (RWX)
;MFA5 JSMFR MFTR1 MFTR10 MFB5 MFB4 MFC1 MFTR2 MTRPAL MFTR3 MFTR4 MFTR5 MFTR6 MFTR7 MFTR9 MFTR41 MAPRST MAPRSS MAPRSL
	D[MEM] MASK[13] DEST[Q] SHORT $; GET ABS PAGE #
	D[CONST 40] ROT[6] ALU[DORQ] DEST[MA HI-ABS-MA] SHORT $; GET CORE STATUS ENTRY
	D[IR] ROT[12] ALU[NOTD] DEST[Q] CYLEN[FIXM] $; GET RWX DISABLES
	D[CONST 24] ROT[25] ALU[D&Q] DEST[Q] SHORT $; GET ONLY R & X
	D[CONST 4] ROT[25] ALU[D+Q] DEST[Q] SHORT $; MOVE X BIT LEFT 1
	D[MA] ROT[11] MASK[24] ALU[DORQ] DEST[Q] SHORT $; OR IN PAGE ADDRS
	D[MEM] ROT[3] MASK[3] COND[OBUS=0] JUMP[MFTR7] C550 $; J IF CST AGE SAYS TRAP
	D[AR] ROT[20] MASK[1] COND[OBUS=0] JUMP[MFA3] C550 $;J IF NO WRT RQ
	D[AR] DEST[IR-ADR] SHORT $; SAVE ORRIGINAL MA
	D[AR] DEST-A-MEM DEST[6] NORM $; SAVE TRAP WORD
	D[MASK 43] ROT[30] ALU[D&Q] DEST[AR] SHORT $; TURN OFF WRT PREVENT, SAVE NEW MAP WORD
	D[CONST 1] ROT[32] DEST[Q] SHORT $; GET MODIFICATION BIT
	D[MEM] MASK[32] ALU[DORQ] DEST[Q] SHORT $; OR INTO CST WORD
MFA5:	D[15] ALU[DORQ] DEST[HOLD] NORM $;OR IN AGE, ETC
	D[MA] DEST[Q] SHORT $; SAVE CST ADDRS

	D[IR] MASK[18.] DEST[MA HI-ABS-MA] NORM $; GET ORIGINAL MA

 .REPEAT NEWMAP [
	D[CONST 1] DEST[DEV-ADR] SHORT $ ;NOW TURN MAP ON.
	D[CONST 4] DEST[IOD] SPEC[IOB-OUT] SHORT $
	MAPF[10] SPEC[IOB-OUT] CYLEN[IOB-OUT] $
	MAPF[2] D[AR] C800$; LOAD MAP
  NOP $ ;%%%%%%% FOR DEBUGGING $$$$$$$$
  ] ; NEWMAP

 .REPEAT 1 - NEWMAP [
	ALU[0] DEST[DEV-ADR] SHORT $ ;NOW TURN MAP ON.
	D[CONST 4] DEST[IOD] SPEC[IOB-OUT] SHORT $
	MAPF[10] CYLEN[IOB-OUT] $
	D[AR] DEST[STO-MAP] NORM $; LOAD MAP
  ] ; 1-NEWMAP

	ALU[0] DEST[IOD] SPEC[IOB-OUT] C800 $ ;MAP OFF
	MAPF[10] CYLEN[IOB-OUT] COND[-USER] JUMP[. + 2] $

	D[CONST 17] ROT[11] DEST[MAP-EXEC-SR] NORM $
	ALU[Q] DEST[MA STRT-WRT] NORM $; STORE CST

.REPEAT 1 - WAITS [
   ;Now add 1 to abs. loc. 30 of main mem (for statistics keeping)
;;;;	D[CONST 30] DEST[MA] NORM PUSHJ[MPINC1] $
];.REPEAT 1 - WAITS

	D[CONST 1] DEST[DEV-ADR] NORM $
	D[16] DEST[AR] NORM $
	ALU[0] DEST[DEV-ADR] NORM $
	D[10 + APRENB] DEST[IOD] SPEC[IOB-OUT] NORM $; TURN MAP BACK ON, ETC.
	MAPF[10] CYLEN[MAX,IOB-OUT,C550]
			D[AR] ROT[15] MASK[1] COND[-OBUS=0] JUMP[JSMFR] $
		; DO SPECIAL JSYS STUFF IF APPROPRIATE
	D[AR] ROT[20] MASK[1] COND[OBUS=0] JUMP[MAIN]  C550 $; DONE IF NO WRT
	D[AR] ROT[17] MASK[1] COND[-OBUS=0] JUMP[MAIN] C550 $; DONE IF READ
	D[AR] MASK[18.] DEST[MA] SHORT $;GET ORRIG. MA
	D[CONST 1] DEST[DEV-ADR] SHORT $
	D[17] DEST[MEMSTO] JUMP[MSMAIN1] NORM $; STORE THE STORE DATA, & PROCEDE

MPINC1:	NORM $  ;Wait for mem fetch to finish.
	D[MEM] ALU[D+1] DEST[MEMSTO] NORM $
	 ;Add one to data and store back in same mem loc.
 .REPEAT NEWMAP [
	ALU[0] DEST[MAP-DISABLE] NORM POPJ $
     ]
 .REPEAT 1 - NEWMAP [
	NORM POPJ $
     ]

JSMFR:	D[AR] MASK[18.] DEST[MA] NORM $
	D[CONST 1] DEST[DEV-ADR] NORM $
	D[17] DEST[AR] JUMP[MUJSM1] NORM $; RESTORE STORE DATA

MFTR1:	D[MEM] ROT[11] MASK[1] COND[-OBUS=0] JUMP[MFTR9] C550 $; J IF TRAP TO USER
	D[MEM] ROT[12] MASK[1] COND[-OBUS=0] JUMP[MFTR10] C550 $;J IF WRT TRAP
	D[MEM] JUMP[MFTR2] NORM $; TREAT BOTH "TRAP-TO-MON" CODES AS IMMEDIATE
MFTR10:	D[AR] ROT[20] MASK[1] COND[OBUS=0] JUMP[MFB3] C550 $; WRT RQ? J IF NO
	D[CONST 44] ROT[36] DEST[Q] SHORT $; GET ERROR CODE BITS -- WRT TRAP
MFB5:
MFB4:	D[AR] ALU[DORQ] DEST[AR Q] COND[USER] JUMP[. + 2] NORM $; OR ERROR BITS IN, J IF USER MODE
	D[CONST 1] ROT[18.] ALU[DORQ] DEST[AR] NORM $; TURN ON EXEC BIT
	D[CONST 5] ROT[6] DEST[Q] SHORT $
	D[CONST 71] ALU[DORQ] DEST[Q] SHORT $; FORM 571
	D[14] ALU[DORQ] DEST[MA HI-ABS-MA] SHORT $; ADD PSB (MON BASE TAB)
	D[AR] DEST[MEMSTO] CYLEN[FIXM] $; STORE ERROR BITS THERE
	D[AR] ROT[20] MASK[1] COND[OBUS=0] JUMP[MFC1] C550 $; J IF NO WRT RQ
	D[AR] ROT[17] MASK[1] COND[-OBUS=0] JUMP[MFC1] C550 $; J IF RD RQ
	D[MA] ALU[D+1] DEST[MA] SHORT $; GO TO 572
	D[17] DEST[MEMSTO] NORM $; SAVE STORE DATA
MFC1:	ALU[0] DEST[DEV-ADR] CYLEN[MEMSTO] $
	ALU[0] DEST[IOD] SPEC[IOB-OUT] NORM $; TURN OFF MAP
	MAPF[10] ALU[0] DEST[HI-ABS-MA] CYLEN[IOB-OUT] $
	D[CONST 70] DEST[MA] SHORT $; FETCH TRAP INSTR
	ALU[0] DEST[DEV-ADR] CYLEN[FIXM] $
	D[10 + APRENB] DEST[IOD] SPEC[IOB-OUT] SHORT $; TURN ON MAP
	D[PC] DEST[Q AR] MAPF[10] CYLEN[IOB-OUT] $
	D[MASK 43] ROT[37] ALU[D&Q] DEST[CRYOV] NORM $;CLR USER
	D[CONST 55] ROT[2] DEST[Q] JUMP[MUUO44] NORM $
MFTR2:	D[CONST 41] ROT[36] DEST[Q] JUMP[MFB5] NORM $; ASCCESS PERMISSION TRAP
MTRPAL:
MFTR3:	D[CONST 40] ROT[36] DEST[Q] SHORT $
	D[CONST 1] ROT[33] ALU[DORQ] DEST[Q] JUMP[MFB5] NORM $; ILLEGAL PT ENTRY TYPE, ADDRESS LIMIT
MFTR4:	;ALL THESE ARE NOT-IN-CORE
MFTR5:	D[CONST 22] ROT[36] DEST[Q] JUMP[MFB5] NORM $; NOT-IN-CORE
MFTR6:	D[CONST 5] ALU[D&Q] COND[OBUS=0] JUMP[. + 3] C550 $; J IF NO R OR X ERROR
	D[CONST 4] ROT[33] ALU[DORQ] DEST[Q] SHORT $; OR IN "R OR X ERROR" BIT
	D[CONST 2] ALU[D&Q] COND[OBUS=0] JUMP[. + 2] C550 $; J IF NO W ERROR
	D[CONST 2] ROT[33] ALU[DORQ] DEST[Q] SHORT $; OR IN W ERROR BIT
	D[CONST 7] ALU[-D&Q] DEST[Q] SHORT $
	D[CONST 40] ROT[36] ALU[DORQ] DEST[Q] JUMP[MFB4] NORM $; GROUP 2
MFTR7:	D[CONST 10] ROT[36] DEST[Q] JUMP[MFB4] NORM $; AGE ERR -- GROUP 0
MFTR9:	D[CONST 42] ROT[36] DEST[Q] JUMP[MFB4] NORM $; USER TRAP
MFTR41:	D[CONST 20] ROT[36] DEST[Q] NORM $; GROUP 1
	D[CONST 1] ROT[33] ALU[DORQ] DEST[Q] JUMP[MFB4] NORM $; TOO MANY INDR. PNTRS
;------------------------------------------------------------------------------
;Reset map.  Clear entire map to zero.  This is because even though the map
;will stop stores from happening, fetches still happen irregardless of state
;of map and if map points at non-existent memory (on for example, an immediate
;mode instruction), the machine will get a spurious ECC interrupt.
;
;It is assumed that the device address is set to 1 when this thing is called.
;------------------------------------------------------------------------------
MAPRST:	SET-TEMP-EXEC $
		;Begin at the beginning of EXEC space.
	D[CONST 1] ROT[9.] DEST[Q] SHORT $
		;Increment for MA
MAPRSS:	D[CONST 1] ROT[18.] ALU[D-Q] DEST[MA] NORM $
		;Start at the top and work down.
MAPRSL:
.REPEAT 1 - NEWMAP [
	D[CONST 1] ROT[35. - 9.] DEST[STO-MAP] NORM $
		;Set mapping to zero, Invalid
	D[MA] ALU[D-Q] DEST[MA] COND[-MA-AC] JUMP[. - 1] C550 $
		;Repeat for each page in this space.
];.REPEAT 1 - NEWMAP
.REPEAT NEWMAP [
	START-OUT SHORT $
	MAPF[2] D[CONST 1] ROT[35. - 9.] NORM $
		;Set mapping to zero, Invalid
	D[MA] ALU[D-Q] DEST[MA] COND[-MA-AC] JUMP[. - 2] C800 $
		;Repeat for each page in this space
];.REPEAT NEWMAP
	SET-TEMP-USER COND[-USER] JUMP[MAPRSS] $
		;Repeat once more if currently doing EXEC space. This
		;time for USER space.  We can do this because EXEC-SR is
		;latched at the end of the cycle.
	ALU[0] DEST[DEV-ADR] NORM $
	D[CONST 1] DEST[IOD] SPEC[IOB-OUT] NORM $
	MAPF[14] CYLEN[IOB-OUT] D[CONST 3] DEST[MAP-DISP] $
	DEST[CLR-MI-ERR] POPJ $	;Done

;JSYS1 JSYS2 UMOVX XCT1 XCTUMV XCT5 XCT4 XCT6 XCT3 XCT13 XCT18 XCT12 XCT11 XDISP XCT2 XFIXMA XCTAC XCTSTK XCTS1 XCTS2 XCT10 XCTBLG XCTBYT XBY1 XBY4 XBY15 XBY14 XBY13 XBY3
;------------------------------------------------------------------------------
;
;	BBN added instructions.  Sometimes used by other than TENEX
;
;------------------------------------------------------------------------------
JSYS1:	FIXM1 $
	D[PC] DEST[AR] NORM $	;SAVE PC & FLAGS
	D[MEM] MASK[18.] DEST[PC] NORM $; JUMP TO RIGHT HALF
	D[MEM] ROT[18.] MASK[18.] DEST[MA] SHORT $
	D[AR] DEST[MEMSTO] MEMSTMA $
JSYS2:	C550 D[CONST 1] ROT[36] ALU[D&Q] COND[OBUS=0] JUMP[. + 2] $; J IF EXEC MODE
	ALU[0] DEST[MAP-EXEC-SR]  NORM $; TEMP TURN OFF USER
	D[CONST 10] ROT[6] DEST[Q] SHORT $
	D[MA] ALU[DORQ] DEST[MA] SHORT $; FETCH POINTER WORD
	FIXM1  $
	D[MEM] MASK[18.] DEST[PC] NORM $; J TO RIGHT HALF
	D[PC] DEST[Q] SHORT $
	D[AR] ROT[5] C550 COND[OBUS<0] JUMP[. + 2] $
		;If we came from exec mode, then we...
	D[CONST 1] ROT[34] ALU[DORQ] DEST[Q] SHORT $
		; ...TURN ON FLAG BIT 7
	D[CONST 1] ROT[36] ALU[-D&Q] DEST[CRYOV] SHORT $; TURN OFF USER
	D[MEM] ROT[18.] MASK[18.] DEST[MA] SHORT $; LEFT HALF
	D[AR] DEST[MEMSTO] MEMSTMA $; STORE PC

  .DEFINE JCFM [JAD]
[	D[PC] ROT[10] MASK[1] COND[-OBUS=0] JUMP[JAD] C550 $;J IF CALL FM MON]

UMOVX:	COND[USER] JUMP[MUUO] NORM $
	D[MEM] DEST[Q] NORM $
	D[CONST 1] ROT[41] ALU[D+Q] DEST[HOLD] NORM $
	D[CONST 5] DEST[Q] JUMP[XCTUMV] NORM $

;------------------------------------------------------------------------------
;
;	XCTR - Execute Relocated
;
;	If in Exec mode and the AC field of the XCT instruction is non-zero,
;	it means do some of the references from User mode if PC bit (?),
;	meaning JSYS from Moniter, is not set.
;
;	This code is not map dependent, although other maps (like ITS) may code
;	the bits in the AC field differently, requiring some rewriting.
;
;	Warning:  This code is complex and prone to bugs.  Many probably lurk
;		  in the cracks.  If you find one, please document it even if
;		  no solution seems to appear.
;------------------------------------------------------------------------------
XCT1:	D[PC] ALU[D-1] DEST[PC] NORM $
	COND[USER] JUMP[XCT2] NORM $
	D[IR] ROT[15] MASK[4] DEST[Q] SHORT $; SAVE XCT AC FLD
XCTUMV:	D[MEM] DEST[AR IR-ALL MA] COND[-MEM-IDX-IND] JUMP[XCT3] NORM $
XCT5:	D[IR] ROT[18.] MASK[4] COND[OBUS=0] JUMP[XCT4] C550 MAPF[2] $; J IF NO IDX FLD
	D[IR] MASK[18.] ALU[IX+D] DEST[MA IR-ADR AR] $; DO INDEX
XCT4:	D[IR] ROT[16] MASK[1] COND[OBUS=0] JUMP[XCT3] C550 MAPF[2] $; J IF NO INDR
	D[CONST 10] ALU[D&Q] COND[-OBUS=0] PUSHJ[XFIXMA] C550 $; PUSHJ IF ADDR CALC USER
XCT6:
	ACSEL[MA] ALU[AC] DEST[FIXMAC-MAPF-RD] MAPF[NORM-IND] CYLEN[FIXM] $
;;;	FIXM1 $
;;;		;It was overdecrementing PC  TVR-Mar80
	SET-TEMP-EXEC $
	D[MEM] DEST[AR IR-23 MA] COND[MEM-IDX-IND] JUMP[XCT5] NORM $
XCT3:	ALU[Q] DEST[IR-ADR] SHORT  MAPF[2] $; SAVE XCT AC FLD
	D[IR] ROT[7] MASK[7] DEST[Q] SHORT $; GET HO 7 BITS OF OPCODE
	D[CONST 54] ALU[D#Q] COND[OBUS=0] JUMP[XCTSTK] C550 $; J IF STACK GROUP
	D[CONST 27] ALU[D#Q] COND[OBUS=0] JUMP[XCTBYT] C550 $; J IF BYTE GROUP
	D[CONST 52] ALU[D#Q] COND[OBUS=0] JUMP[XCTBLG] C550 $; J IF GROUP WITH BLT IN IT
XCT13:	D[IR] MASK[4] DEST[Q] SHORT $; GET XCT AC FLD
XCT18:	D[CONST 5] ALU[D&Q] COND[OBUS=0] JUMP[XDISP] C550 $; J IF NEITHER RELEVANT BIT
	COND[MA-AC] JUMP[XCT10] NORM $; J IF EF ADR IS AC
	JCFM[XDISP] ;J IF CALL FM MON
	D[CONST 1] ALU[D&Q] COND[OBUS=0] JUMP[XCT11] C550 $;J IF BIT OFF
	D[CONST 4] ALU[D&Q] COND[OBUS=0] JUMP[XCT12] C550 $; J IF OTHER BIT OFF
	D[CONST 03] ROT[11] DEST[MAP-EXEC-SR] JUMP[XDISP] NORM $; SET SRC & DEST TO USER
XCT12:	D[CONST 02] ROT[11] DEST[MAP-EXEC-SR] JUMP[XDISP] NORM $; SET DEST TO USER
XCT11:	D[CONST 01] ROT[11] DEST[MAP-EXEC-SR] NORM $; SET SRC TO USER
XDISP:	D[MA] DEST[MA IR-ADR] DISP[2000] SPEC[PC+1-IF] CYLEN[DISP] $

;This is the dispatch for normal non-relocated XCT
XCT2:	D[MEM] DEST[IR-ALL AR MA] DISP[2174] SPEC[PC+1-IF] CYLEN[DISP] $

;Call here after setting MA if this memory cycle is supposed to
;be relocated to the previous address space.
;This must preserve Q and AR, some callers depend on it.
XFIXMA:	COND[MA-AC] JUMP[XCTAC] NORM $; J IF ADDRS IS AC
	D[PC] ROT[10] MASK[1] COND[-OBUS=0] POPJ C550 MAPF[2] $; LEAVE IF CALL FM MON
	SET-TEMP-USER $
	D[MA] DEST[MA] POPJ NORM $

;MA is reference to AC of previous address space.
XCTAC:
.REPEAT 1 - WAITS [
	ACSEL[AC] ALU[AC] DEST[HOLD]  SHORT $; SAVE AC
	ACSEL[AC] DEST[CLR-DEV-FROM-INTR AC] D[MA] SHORT $; GET AC ADDRS
	D[CONST 1] DEST[DEV-ADR] SHORT $
	ACSEL[AC] D[13] ALU[D+AC] DEST[AC] SHORT $; ADD IN AC BASE REG.
	ACSEL[AC] D[CONST 75] ROT[11] ALU[D+AC] DEST[AC] SHORT $
	ACSEL[AC] D[CONST 7] ROT[17] ALU[D+AC] DEST[AC] NORM $
	D[MEM] ACSEL[AC] DEST[O_AC MA] POPJ NORM $
];.REPEAT 1 - WAITS
.REPEAT WAITS [
	D[PC] ROT[10] MASK[1] COND[-OBUS=0] POPJ C550 MAPF[2] $; LEAVE IF CALL FM MON
	ACSEL[AC] D[MA] DEST[O_AC HOLD] $
		;Get address of AC, we need to mung it
		;Save AC, we can't use Q for some reason [???]
	ACSEL[AC] D[CONST 77] ROT[9. + 3.] ALU[D+AC] DEST[AC] NORM $
		;Add page number of window
		;Use 770xxx for window into user ACs
	D[MEM] ACSEL[AC] DEST[O_AC MA CLR-DEV-FROM-INTR] NORM $
		;Restore AC and set MA from AC to start read
.REPEAT 1 - NEWMAP [
	D[CONST 1] DEST[DEV-ADR] NORM $
		;Select appropriate A-MEM
	D[13] ROT[9.] MASK[36. - 13.] DEST[STO-MAP] COND[OBUS=0] JUMP[.] NORM $
		;Extract address and position for map
		;Not R,W,X excluded.  Not NO ENTRY AT ALL
		;Hang if attempt to reference user ACs with no shadow
		;memory defined at time of CONO PAG,
];.REPEAT 1 - NEWMAP
.REPEAT NEWMAP [
 	D[CONST 1] DEST[DEV-ADR] SPEC[IOB-OUT] NORM $
		;Select appropriate A-MEM
		;Set place in map to write it and start map write
	MAPF[2] ROT[9.] MASK[36. - 13.] COND[OBUS=0] JUMP[.] NORM $
		;Finish map write.
		;Not R,W,X excluded.  Not NOT ENTRY AT ALL
		;Hang if attempt to reference user ACs with no shadow
		;memory defined at time of CONO PAG,
];.REPEAT NEWMAP
	D[MA] DEST[MA] POPJ NORM $
];.REPEAT WAITS

XCTSTK:
;;;	COND[-MA-AC] JUMP[XCT13] NORM $; J IF EF ADR NOT AC (TREAT NORMALLY)
	D[IR] ROT[11] MASK[2] DEST[Q] COND[OBUS=0] JUMP[XCT13] C550 $; GET 2 LOW ORDER BITS OF OP CODE, J IF PUSHJ
	D[CONST 3] ALU[D#Q] COND[OBUS=0] JUMP[XCT13] C550 $; J IF POPJ
.repeat 0[
	D[CONST 2] ALU[D#Q] COND[OBUS=0] JUMP[XCTS1] C550 $; J IF POP
	D[CONST 4] DEST[Q] JUMP[XCTS2] NORM $
XCTS1:	D[CONST 1] DEST[Q] SHORT $
XCTS2:	D[IR] ALU[D&Q] COND[OBUS=0] JUMP[XCT13] C550 $; J IF AC REF NOT USER
	D[IR] ALU[D-Q] DEST[IR-ADR] PUSHJ[XCTAC] NORM $; FIX EF ADR.
	MAPF[2] JUMP[XCT13] NORM $
];.repeat 0
	D[CONST 2] ALU[D#Q] COND[OBUS=0] JUMP[XPOP1] C550 $; J IF POP
	JUMP[XPUSH1] NORM $
		;Someday, move code over here (when we have space)

XCT10:	PUSHJ[XCTAC] NORM $; FIX EF ADR
	MAPF[2] D[MA] MASK[4] DEST[IR-ADR] DISP[2000] SPEC[PC+1-IF] CYLEN[DISP] $
XCTBLG:	D[IR] ROT[11] MASK[2] DEST[Q] COND[OBUS=0] JUMP[XCT13] C550 $; GET 2 LO BITS OF OPCODE, J IF EXCH
	D[CONST 1] ALU[D#Q] COND[OBUS=0] JUMP[XCTBLT] C550 $; J IF BLT
	D[IR] MASK[4] DEST[Q] JUMP[XCT18] NORM $; GET XCT AC FLD, PROCEDE

;XCTR of byte instruction.  AC field bits:
;	4 - byte pointer in previous address space
;	2 - byte pointer address calculation in previous address space
;	1 - byte in previous address space
XCTBYT:	D[IR] ROT[42] MASK[1] SPEC[PC+1] COND[-OBUS=0] PUSHJ[XFIXMA] C550 $; PUSHJ IF B.P. FETCH IS NOT EXEC
XBY1:	D[IR] ROT[11] MASK[1] COND[OBUS=0] JUMP[XBY3] C550 MAPF[2] $;J IF BP WILL BE INCR
	FIXM1 $
	D[MEM] DEST[AR Q] NORM $; GET BP
XBY4:	SET-TEMP-EXEC $
	D[AR] MASK[18.] DEST[MA] COND[-MEM-IDX-IND] JUMP[XBY13] NORM $; J IF BP HAS NO IDX OR INDR
XBY15:	D[AR] ROT[18.] MASK[4] DEST[AC-SEL] COND[OBUS=0] JUMP[XBY14] C550 MAPF[2] $; J IF NO IX FLD
	D[IR] ROT[43] MASK[1] COND[OBUS=0] JUMP[XBY16] C550 $;J IF BP ADR CALC NOT USER
	D[AR] ROT[18.] MASK[4] DEST[MA] PUSHJ[XCTAC] NORM $;FETCH IDX REG
	FIXM1 $
	D[MASK 4] ROT[18.] ALU[-D&Q] DEST[Q] NORM $;CLEAR INDEX FIELD OF Q
	D[MEM] MASK[18.] ALU[D+Q] DEST[Q AR MA] JUMP[XBY14] NORM $
		;Above instruction makes the indexed byte pointer, with
		;garbage in bits 14-17 that doesn't hurt anything.
		;There will be no carry into PPSS.

XBY16:	D[MASK 18.] ROT[18.] ALU[D&Q] DEST[Q] NORM $	;HLLZS BP IN Q
	D[AR] MASK[18.] ACSEL[REG] ALU[D+AC] DEST[AR] SHORT $
	D[AR] MASK[18.] ALU[DORQ] DEST[Q AR MA] SHORT $
XBY14:	D[AR] ROT[16] MASK[1] COND[OBUS=0] JUMP[XBY13] C550 MAPF[2] $; J IF NO INDR
	D[IR] ROT[43] MASK[1] COND[-OBUS=0] PUSHJ[XFIXMA] C550 $; PUSHJ IF BP ADR CALC IS USER
	FIXM1 $
	SET-TEMP-EXEC $
	D[AR] ROT[14] MASK[14] DEST[AR] SHORT $
	D[AR] ROT[30] DEST[Q] SHORT $
	D[MEM] MASK[27] ALU[DORQ] DEST[Q AR MA] COND[MEM-IDX-IND] JUMP[XBY15] NORM $
XBY13:	D[IR] MASK[1] COND[-OBUS=0] PUSHJ[XFIXMA] MAPF[2] $; MAKE MA OK
	D[IR] ROT[10] MASK[1] COND[OBUS=0] JUMP[LDB5] C550 MAPF[2] $; DISTINGUISH LOADS FROM DEPOSITS, J IF LOAD
	JUMP[DPB5] NORM $

XBY3:	FIXM2 $
	D[MEM] DEST[AR Q] COND[HALF] JUMP[XBY4] NORM $;GET BP, J IF NO INCR
	D[AR] ROT[14] MASK[6] DEST[AR MASKR] COND[BYTE-OVF] PUSHJ[IBT1] NORM $; GET S FLD, HANDLE OVERFLOW
	D[AR] ROT[36] ALU[Q-D] DEST[Q AR MEMSTO] COND[-MA-AC] JUMP[. + 2] NORM $; SUB S FROM P
	ACSEL[MA] D[MEM] DEST[AC] NORM $
	PUSHJ[SETHLF] NORM $; SET HALF
	JUMP[XBY4] NORM $; (IN CASE OF MAP FAULTS)

;XCTBLT XBLTL XPUSH1 XPDLO2 XPOP1 XPOP2 XPOP3

;;;;;.USE[OTHER]  DWP 9-19-80

XCTBLT:	D[MA] SPEC[PC+1] DEST[O_AC AR] NORM $; END ADR IN AC, AC IN AR
XBLTL:	D[AR] ROT[18.] MASK[18.] DEST[MA] SHORT $; GET WORD
	D[IR] ROT[42] MASK[1] COND[-OBUS=0] PUSHJ[XFIXMA] C550 $; FIX IF USER ADDRS
	ACSEL[MA] ALU[AC] DEST[FIXMAC-MAPF-RD] MAPF[BLT-RDA] CYLEN[FIXM] $
	D[MEM] DEST[Q] SHORT $; GET DATA WORD
	D[AR] MASK[18.] DEST[MA] SHORT $; GET DEST ADR
	D[IR] MASK[1] DEST[MAP-EXEC-SR] COND[-OBUS=0] PUSHJ[XFIXMA] C550 $;FIX MA ADDRS
	ALU[Q] DEST[MEMSTO] SHORT $
	D[AR] MASK[18.] ALU[D-AC] MAPF[BLT-WRTB] COND[-OBUS<0] JUMP[BLTA12] C600 $
	D[CONST 1,,1] DEST[Q MAP-EXEC-SR] COND[-MA-AC] JUMP[. + 2] NORM $
	D[MEM] ACSEL[MA] DEST[AC] SHORT $
	D[AR] ALU[D+Q] DEST[AR] JUMP[XBLTL] NORM $; TEST FOR INTERPT HERE ? *****

;Special case for PUSH.  Check for AC reference from stack pointer
XPUSH1:	D[IR] MASK[1] COND[OBUS=0] JUMP[XCT13] C550 $
		;If not mapping stack references, it's simple
	D[IR] ROT[36. - 2] MASK[1] COND[-OBUS=0] PUSHJ[XFIXMA] SPEC[PC+1] C550$
		;Make sure we're referring to the right place here.
		;Also, we're now executing the instruction (PC+1)
	FIXM1 $	;Check page faults for effective address part.
	D[MEM] DEST[AR] NORM $
		;Copy away the thing that we want to push
	D[CONST 1,,1] ALU[D+AC] DEST[AC MA] COND[CRY0] JUMP[XPDLO2] C550 $
		;Advance frame pointer and check for overflow
	PUSHJ[XFIXMA] NORM $
		;Decide whether to map destination.
	D[AR] DEST[MEMSTO] MEMST $
		;Finish instruction. We're done
XPDLO2:	PUSHJ[XFIXMA] NORM $
		;Fixup AC references
	JUMP[PDLO2] NORM $
		;Done.  Take stack overflow trap

;Special case for POP.  Check for AC reference from stack pointer
XPOP1:	D[IR] ROT[11] DEST[Q] NORM SPEC[PC+1] $
		;Save bit meaning 'source from user' in format that can
		;be fed easily to EXEC-SR
		;Now we're executing the PUSH (implied by PC+1)
	D[MA] DEST[IR-ADR] NORM $
		;Restore normal effective address 
	ACSEL[AC] D[CONST 1,,1] ALU[AC-D] DEST[MA O_AC] NORM $
		;Update AC and MA for stack reference
	D[CONST 4] ROT[11] ALU[D&Q] COND[-OBUS=0] PUSHJ[XFIXMA] C550 $
		;Fixup stack addressing if user AC
	ACSEL[MA] ALU[AC] DEST[FIXMAC-MAPF-RD] MAPF[PPOP] CYLEN[FIXM] $
		;Check for page faults
	D[MEM] DEST[AR] NORM $
		;Find somewhere safer for thing to push
	D[CONST 1] ROT[11] ALU[D&Q] DEST[MAP-EXEC-SR]
			COND[OBUS=0] JUMP[XPOP3] C550 $
		;Set appropriate mode to do store in
	D[IR] MASK[22] DEST[MA] NORM $
		;Extract address and fetch it from the appropriate page.
	COND[MA-AC] PUSHJ[XCTAC] NORM $
		;Fixup AC addressing if needed.  (We can't combine this and
		;previous instruction because MA is strobed at end of cycle.
		;We can't call XFIXMA because it uses SET-TEMP-USER which
		;would affect the next instruction fetch. Sigh...)
XPOP2:	D[CONST 1,,1] ALU[D+AC] COND[CRY0] JUMP[PDLO5] C550 $
		;Try for overflow again.  Take it if you need it.
	D[AR] DEST[MEMSTO] MEMST $
		;Write out thing we POP'ped
XPOP3:	D[IR] MASK[22] DEST[MA] NORM JUMP[XPOP2] $
		;Extract address and don't do anything special about it

;APRDSP PIDSP AREA53 APRCO APRCO2 APRCO3 APRIEN APRC1 APRC2 APRCHK APRCK1 APDINT APRCI APRCII APRDI APIOT
;------------------------------------------------------------------------------
;
;	APR and PI instructions
;
;------------------------------------------------------------------------------
	.ORG[5300]	 ;APR & PI IOT DISP TABLE
APRDSP:	ILGIOT $; BLKI APR
	NOP $
	ALU[0] DEST[DEV-ADR] NORM $; DATAI -- RD SW
	DEST[CLR-DEV-FROM-INTR] SPEC[IOB-IN] JUMP[APRDI] NORM $
	ILGIOT $ ;BLKO APR
	NOP $
	JUMP[MAIN] $; DATAO
	NOP $
	D[IR] MASK[13] DEST[Q] NORM $; GET CONO BITS
	D[CONST 33] ROT[5] ALU[-D&Q] DEST[Q] JUMP[APRCO] NORM $
	PUSHJ[APRCI] NORM $; CONI -- GET BITS IN AR & Q
	D[AR] MASK[18.] DEST[MEMSTO] MEMST $
	PUSHJ[APRCI] NORM $; CONSZ -- GET BITS IN AR & Q
	D[IR] MASK[18.] DEST[Q] JUMP[CTYCZ] NORM $
	PUSHJ[APRCI] NORM $; CONSO -- GET BITS IN AR & Q
	D[IR] MASK[18.] DEST[Q] JUMP[CTYCS] NORM $
PIDSP:	.REPEAT 3[ ILGIOT $
	NOP $
]
	;DATAO PI -- Set lights
	D[CONST 0] DEST[DEV-ADR] PUSHJ[SETLTS] NORM $	;Just like examine...?
	JUMP[MAIN] SHORT $
	JUMP[PICONO] NORM $; PI CONO
	NOP $
	PUSHJ[PICONISUB] NORM $; CONI -- GET BITS IN AR & Q
	D[AR] DEST[MEMSTO] MEMST $
	PUSHJ[PICONISUB] NORM $; CONSZ -- GET BITS IN AR & Q
	D[IR] MASK[18.] DEST[Q] JUMP[CTYCZ] NORM $
	PUSHJ[PICONISUB] NORM $; CONSO -- GET BITS IN AR & Q
	D[IR] MASK[18.] DEST[Q] JUMP[CTYCS] NORM $


   .USE[NORMAL]

APRCO:	D[CONST 1] ROT[3] ALU[-D&Q] DEST[AR] SHORT $
	D[IR] ROT[43] MASK[21] ALU[NOTD] DEST[Q] SHORT $
		; GET CLR BITS
	D[CONST 7] ALU[-D&Q] DEST[Q] SHORT $
		; Remove PI assignment
	D[10 + APRSTS] SPEC[A-MEM-APR] ALU[D&Q] DEST[Q CLR-DEV-FROM-INTR] SHORT $
		; CLEAR INDICATED BITS
	D[AR] ALU[DORQ] SPEC[A-MEM-APR&DEST-A-MEM] DEST[APRSTS AR] NORM $
		; SET INDICATED BITS & CHAN
	D[IR] ROT[41] MASK[1] COND[OBUS=0] JUMP[APRCO2] C550 $
		; J IF NO CLR OVERFLOW BIT
	D[PC] MASK[43] DEST[CRYOV] SHORT $; CLR OV
		; Remove overflow bit from current PC flags
APRCO2:	D[IR] ROT[36] MASK[1] COND[OBUS=0] JUMP[APRCO3] C550 $
		; J IF NO CLR FLT OV
	D[MASK 43] ROT[41] DEST[Q] SHORT $
		; Remove bit from current PC flags
	D[PC] ALU[D&Q] DEST[CRYOV] SHORT $
		; CLR FLT OV
APRCO3:	D[IR] ROT[33] MASK[1] COND[-OBUS=0] PUSHJ[CLKCLR] C550 $
		; CLR CLOCK FLAG IF INDICATED
;	---

; TEMP **** APRCI:
APRIEN:	PUSHJ[APRCII] DEST[CLR-DEV-FROM-INTR] NORM $
		; GET APR CONI BITS
	D[CONST 1] DEST[DEV-ADR] SPEC[IOB-IN] NORM $
		; Select and read MAP and ECC enablings
	D[IOD] MAPF[4] MASK[3] DEST[Q] CYLEN[IOB-IN] $
	ALU[0] DEST[DEV-ADR] SHORT $
		; For some pecular reason, the thing we read from device 1 is
		; written in device 0???
	D[AR] MASK[3] COND[OBUS=0] JUMP[APRC1] C550 $
		; Jump if no PI channel.  We don't want to enable arithmetic
		; micro-interrupts in that case.
	D[AR] ROT[40] MASK[1] COND[OBUS=0] JUMP[APRC1] C550 $
		; J IF NO OV INT ENBL
		; *** Don't both enables need to be checked???
	D[CONST 2] ALU[DORQ] DEST[IOD] SPEC[IOB-OUT] JUMP[APRC2] NORM $; ENABLE OV INT
		; Turn on arithmetic interrupts
APRC1:	D[CONST 2] ALU[-D&Q] DEST[IOD] SPEC[IOB-OUT] NORM $; CLR OV INT
		; Turn off arithmetic interrupts
APRC2:	MAPF[10] CYLEN[IOB-OUT] D[AR] DEST[Q] JUMP[APRCK1] $
		; Finish turning arithmetic interrupts off or on, and we're done

;Check for clock interrupts (and other things)
APRCHK:	PUSHJ[APRCI] NORM $; GET CONI BITS IN AR & Q

APRCK1:
.REPEAT 1 - WAITS [
	D[AR] MASK[3] COND[OBUS=0] JUMP[MAIN] C550 $; DONE IF PI=0
	D[AR] ROT[24] MASK[1] COND[-OBUS=0] JUMP[APDINT] C550 $; J IF PDLOV INT
	D[AR] ROT[43] ALU[D&Q] DEST[Q] SHORT $; AND MASK WITH FLAG
	D[CONST 11] ROT[3] ALU[D&Q] COND[-OBUS=0] JUMP[APDINT] C550 $; J IF OV INT
	D[CONST 10] ROT[6] ALU[D&Q] COND[OBUS=0] JUMP[MAIN] C550 $; DONE IF NO CLOCK INT
;	\ /
];.REPEAT 1 - WAITS
.REPEAT WAITS [
	D[AR] ROT[27.] COND[OBUS<0] SPEC[MA_PC] DEST[MA] JUMP[MAIN1] C550 $
		;If no APR interrupt is not requested, don't interrupt.
		;Otherwise, fall thru
];.REPEAT WAITS

;	\ /	(Falls thru from APRCK1)
APDINT:	D[AR] MASK[3] DEST[Q AR] JUMP[PIGEN] NORM $; GET CHAN #, CAUSE INTERRUPT

APRCI:	;TEMP -- LATER WE FIX OV
APRCII:	PUSHJ[CLKRDFLG] NORM $
	 ;Get CLOCK FLAG in AR 35, rest of AR = 0
	.DEFINE APRGBT [R1 R2]
[	D[PC] ROT[R1] MASK[1] DEST[Q] SHORT $
	D[AR] ROT[R2] ALU[DORQ] DEST[AR] SHORT $
]
	APRGBT[1 6]
	APRGBT[4 41]
	APRGBT[7 33]
	D[AR] ROT[17] DEST[Q] SHORT $; SET FLAGS
.REPEAT 1 - WAITS [
	D[10 + APRSTS] SPEC[A-MEM-APR] ALU[DORQ] DEST[Q AR] NORM POPJ $
];.REPEAT 1 - WAITS

.REPEAT WAITS [
;SAIL's KA-10 has a processor modification which sets bit 27 (400 bit) if the
;APR is NOT interrupting.  This feature is used in a CONSZ chain and would
;consume many instructions to simulate in a critical path in the system.
	D[10 + APRSTS] SPEC[A-MEM-APR] ALU[DORQ] DEST[Q AR] NORM $
		;Construct full status
	D[AR] MASK[3] COND[OBUS=0] JUMP[APRCIN] NORM $
		;Set 400 bit if interrupts disabled 
		;(This may not be the same as SAIL)
	D[AR] ROT[24] MASK[1] COND[-OBUS=0] POPJ C550 $
		;If pushdown overflow, we will interrupt.
	D[AR] ROT[43] ALU[D&Q] DEST[Q] SHORT $
		;Combine flag with enable to see which interrupts
	D[CONST 11] ROT[3] ALU[D&Q] COND[-OBUS=0] JUMP[APRCIY] C550 $
		;Jump if overflow is causing an interrupt.
	D[CONST 10] ROT[6] ALU[D&Q] COND[-OBUS=0] JUMP[APRCIY] C550 $
		;Jump if clock is causing an interrupt.
APRCIN:	D[CONST 4] ROT[6] DEST[Q] SHORT $
		;Not interrupting, set 400 bit in APR status
APRCIY:	D[AR] ALU[DORQ] DEST[AR Q] POPJ NORM $
		;Turn on 400 bit if needed.
		;Note, that since we ANDed something with Q, ORing in Q is
		;a NO-OP if we didn't go thru APRCIN.
];.REPEAT WAITS

APRDI:	MAPF[2] D[IOD] DEST[MEMSTO] COND[-MA-AC] LBJUMP[MSMAIN] CYLEN[IOB-IN] $

	.PAIR
	UIOTRP[MUUO] $			;Trap if not IOT-USER Mode
APIOT:	IOTDIS[53]

;PDLO1 PDLO2 PDLO5 PDLO3 PDLO4 PDLO6  PDLO SOED STOPS SOVRS SECCS SOEDOV

PDLO1:	PUSHJ[PDLO] NORM $ ;SET PDLO BIT
	D[PC] DEST[AR MEMSTO] NORM $
	MAPF[MASTO] D[IR] MASK[18.] SPEC[CLR-HALF] DEST[PC] COND[-MA-AC] LBJUMP[MSMAIN] NORM $
PDLO2:	PUSHJ[PDLO] NORM $; SET FLAG
PDLO5:	D[AR] DEST[MEMSTO] COND[-MA-AC] LBJUMP[MSMAIN] NORM $
PDLO3:	ACSEL[MA] ALU[AC] DEST[FIXMAC-MAPF-RD] MAPF[PPOP] CYLEN[FIXM] $
	D[MEM] DEST[AR] PUSHJ[PDLO] NORM $
	D[IR] MASK[18.] DEST[MA] JUMP[PDLO5] NORM $
PDLO4:	ACSEL[MA] ALU[AC] DEST[FIXMAC-MAPF-RD] MAPF[PPOP] CYLEN[FIXM] $
	PUSHJ[PDLO] NORM $
	D[MEM] MASK[18.] DEST[PC] JUMP[MAIN] NORM $
;PDLOV from ADJSP
PDLO6:	PUSHJ[PDLO] NORM $
	JUMP[MAIN] NORM $ 



PDLO:	D[PC] DEST[Q] SHORT $
	  ;Set bit 9 of PC to indicate that a PDL OV has happened...
	D[CONST 1] ROT[35. - 9.] ALU[DORQ] DEST[CRYOV] NORM POPJ $
	  ;...MAIN will notice this bit and go to PDLTRP below.

PDLTRP:	  ;Here from MAIN when PC bit 9 is on.
	D[10 + APRSTS] A-MEM-APR DEST[Q AR] NORM $
	 ;APR CONI word to Q (leave also in AR to give PIGEN the APR PI chn)
	D[CONST 1] ROT[20] ALU[DORQ] A-MEM-APR&DEST-A-MEM DEST[APRSTS] NORM $
		;set PDLOV bit
	D[PC] DEST[Q] SHORT $
	   ;Now clear the pseudo-trap flag in bit 9 of PC.
	D[CONST 1] ROT[35. - 9.] ALU[-D&Q] DEST[CRYOV] NORM $
	D[AR] MASK[3] DEST[AR] C550 -OBUS=0 JUMP[PIGEN] $
	   ;...and request interrupt (AR already has APR PI chn.)
	JUMP[MAIN] $

  .USE[NORMAL]

.REPEAT F3SW [

SOED:	D[CONST 1] DEST[DEV-ADR] SPEC[IOB-IN] NORM $
	D[IOD] MAPF[2] DEST[Q HOLD] CYLEN[IOB-IN] $
	D[CONST 1] ROT[25] ALU[D&Q] COND[OBUS=0] JUMP[DOHALT] C600 $
	D[PC] COND[-OBUS<0] SPEC[IOB-IN] JUMP[. + 3] C550 $; J IF NO OV
	D[IOD] MAPF[4] DEST[Q CLR-DEV-FROM-INTR] CYLEN[IOB-IN] $
	D[CONST 2] ALU[D&Q] COND[-OBUS=0] JUMP[SOEDOV] C550 $ ;J IF OV INT EN

	NORM JUMP[SOEDA] $

 .USE[NORMAL]

SOEDA:	D[10 + ECCSVP] SPEC[A-MEM-APR] MASK[4] DEST[Q] NORM $
.REPEAT 1 - XUCODE [
	D[MASK 8.] ROT[4] ALU[DORQ] DEST[AR CLR-DEV-FROM-INTR] 
	  NORM SPEC[IOB-IN] $  ;;7760 IS NEW LOC. OF ERROR LOG.
];.REPEAT 1 - XUCODE
.REPEAT XUCODE [
	D[MASK 9.] ROT[4] ALU[DORQ] DEST[AR CLR-DEV-FROM-INTR] 
	  NORM SPEC[IOB-IN] $  ;;17760 IS NEW LOC. OF ERROR LOG.
];.REPEAT XUCODE
  	MAPF[4] D[IOD] DEST[Q] CYLEN[IOB-IN] $
	D[CONST 1] ROT[7] ALU[D&Q] COND[-OBUS=0] JUMP[.] C550 $

	ALU[0] DEST[MUCODE-HI] CYLEN[MUSTO] $
	D[MEM] DEST[Q] NORM $
	D[MASK 42] ROT[25] ALU[D&Q] DEST[MUCODE-LO] CYLEN[MUSTO] $
	D[AR] ALU[D+1] DEST[ECCSVP] SPEC[A-MEM-APR&DEST-A-MEM] NORM $
	SPEC[IOB-IN] D[CONST 1] DEST[DEV-ADR] NORM $
	 ;NOW READ STATE OF MAP ON, OV ENBL, ETC.
	D[IOD] DEST[IR-ADR]  MAPF[4] CYLEN[IOB-IN] $
	 ;PRESERVE IN IR.
	ALU[0] DEST[DEV-ADR] SHORT $
;;;  	D[IR] ROT[31.] COND[OBUS<0] PUSHJ[ECC-UNC] C550 $
	 ;IF ERROR WAS UNCORRECTABLE, GO SEE ABOUT INTERRUPTING.
	ALU[0] DEST[IOD] SPEC[IOB-OUT] NORM $ ;PUT JUNK IN LIGHTS
	MAPF[2] D[MEM] SPEC[IOB-OUT] CYLEN[IOB-OUT] $ ;LTS_OBUS
	MAPF[10] DEST[CLR-MI-ERR] CYLEN[IOB-OUT] $; TURN OFF MAP
	D[MEM] DEST[MA HI-ABS-MA] NORM $; GET DATA
	CYLEN[C500] $;WAIT
	D[MEM] DEST[MEMSTO] NORM $; RE-STORE IT
	NORM $; WAIT -- FOR LUCK
	D[IR] DEST[IOD] SPEC[IOB-OUT] NORM $; RESTORE STATE OF MAP, ETC.
	 MAPF[10] ALU[0] DEST[HI-ABS-MA] CYLEN[IOB-OUT] $;
	DEST[CLR-MI-ERR] JUMP[MAIN] $  ;CLEAR THE ERROR FLIPFLOP

  ]  ;; END OF .REPEAT F3SW

;(ECC-UNC moved to bottom of page)

 .REPEAT F2SW [ 

STOPS:	D[CONST 1] DEST[DEV-ADR] JUMP[DOHALT] NORM $

SOVRS:	D[PC] COND[-OBUS<0] SPEC[IOB-IN] JUMP[. + 3] DEST[CLR-DEV-FROM-INTR] C550 $
		; J IF NO OV
	D[IOD] MAPF[4] DEST[Q CLR-DEV-FROM-INTR] CYLEN[IOB-IN] $
	D[CONST 2] ALU[D&Q] COND[-OBUS=0] JUMP[SOEDOV] C550 $ ;J IF OV INT EN
	JUMP[.] $ ; HOW COULD WE GET HERE?

 .USE[AREA53]

SECCS:	D[CONST 1] DEST[DEV-ADR] SPEC[IOB-IN] NORM $
	D[IOD] MAPF[2] DEST[Q HOLD] CYLEN[IOB-IN] $
	D[10 + ECCSVP] SPEC[A-MEM-APR] MASK[4] DEST[Q] NORM $
.REPEAT 1 - XUCODE [
	D[MASK 8.] ROT[4] ALU[DORQ] DEST[AR CLR-DEV-FROM-INTR] 
	  NORM SPEC[IOB-IN] $  ;;7760 IS NEW LOC. OF ERROR LOG.
];.REPEAT 1 - XUCODE
.REPEAT XUCODE [
	D[MASK 9.] ROT[4] ALU[DORQ] DEST[AR CLR-DEV-FROM-INTR] 
	  NORM SPEC[IOB-IN] $  ;;17760 IS NEW LOC. OF ERROR LOG.
];.REPEAT XUCODE
  	MAPF[4] D[IOD] DEST[Q] CYLEN[IOB-IN] $
 ;;;;;	D[CONST 1] ROT[7] ALU[D&Q] COND[-OBUS=0] JUMP[.] C550 $

	ALU[0] DEST[MUCODE-HI] CYLEN[MUSTO] $
	D[MEM] DEST[Q] NORM $
	D[MASK 42] ROT[25] ALU[D&Q] DEST[MUCODE-LO] CYLEN[MUSTO] $
	D[AR] ALU[D+1] DEST[3] SPEC[A-MEM-APR&DEST-A-MEM] NORM $
	D[CONST 1] DEST[DEV-ADR] NORM $
	DEST[CLR-DEV-FROM-INTR] SPEC[IOB-IN] SHORT $
	D[IOD] DEST[IR-ADR]  MAPF[4] CYLEN[IOB-IN] $
	ALU[0] DEST[DEV-ADR] SHORT $
;NOTE:	This conflicts with the use of the lights by diagnostics.
	ALU[0] DEST[IOD] SPEC[IOB-OUT] NORM $ ;PUT JUNK IN LIGHTS
	MAPF[2] ALU[Q] SPEC[IOB-OUT] CYLEN[IOB-OUT] $ ;LTS_OBUS
	MAPF[10] DEST[CLR-MI-ERR] CYLEN[IOB-OUT] $; TURN OFF MAP
	ALU[Q] DEST[A-MEM-ECC-DATA] DEST-A-MEM NORM $
	  ;Save info for reading via opcode 750.  
	D[MEM] DEST[MA HI-ABS-MA] NORM $; GET DATA
	CYLEN[C500] $;WAIT
	D[MEM] DEST[MEMSTO] NORM $; RE-STORE IT
	NORM $; WAIT -- FOR LUCK
	D[IR] DEST[IOD] SPEC[IOB-OUT] NORM $; RESTORE STATE OF MAP, ETC.
	 MAPF[10] ALU[0] DEST[HI-ABS-MA] CYLEN[IOB-OUT] $;
	DEST[CLR-MI-ERR] JUMP[MAIN] NORM $

  ] ;; END OF .REPEAT F2SW

SOEDOV:	ALU[0] DEST[DEV-ADR] NORM $
	D[CONST 2] ALU[-D&Q] DEST[IOD] SPEC[IOB-OUT] NORM $; CLR OV INT
	MAPF[10] CYLEN[IOB-OUT] PUSHJ[APRCII] $; GET CONI BITS
	D[AR] MASK[3] DEST[Q AR] JUMP[PIGEN] NORM $; DO INTR.

;$*$*$*$ No space left in NORMAL by now...
	.USE[OTHER]

ECC-UNC:  ;SEE IF WE SHOULD GIVE INTERRUPT FOR HARD ECC ERR
	  ;RETURN TO CALLER IF NOT, BUT STILL SET PAR ERR FLAG.
	D[14] DEST[Q] NORM $
	 ;FIRST, SET PAR ERR FLAG IN PI CONI BITS.
	D[CONST 1] ROT[35. - 19.] ALU[DORQ] 
		DEST[AR 4] DEST-A-MEM NORM $
	D[AR] ROT[35. - 20.] C550 COND[-OBUS<0] POPJ $
	 ;IF PAR ERR INTRPT ENABLE OFF, DO NO MORE.
	D[10 + APRSTS] MASK[3] DEST[Q AR] C550 COND[OBUS=0] POPJ $
	 ;IF APR PI CHAN IS 0, DON'T GIVE INTRPT.
	DEST[CLR-MI-ERR] NORM JPOP[PIGEN] $ 
	 ;CLEAR ERR FF AND GIVE INTERRUPT ON APR CHANNEL.

;; 60 HZ CLOCK READING AND INTERRUPT ROUTINES

 .REPEAT OTP [
  .ORG[2134]		;INTRPT LOC. FOR DEV. 5
CLKINT:	NORM PUSHJ[CLRDEVINT] $ ;Enable addressing of other devices.
	D[CONST 1] ALU[NOTD] DEST[Q] PUSHJ[DEV6CL] NORM $
		;Clear hdwr int. enable for 60HZ clk.
    ]  ;OTP


 .REPEAT NTP [ ;We branch here from CTYINT if intrpt. is really 60HZ CLK.

CLKINT:	START-OUT ALU[0] DEST[IOD] NORM $
	  ;Clear hardware int. enb. for 60HZ CLK.
	MAPF[6] C600 $
  ] ;NTP

.REPEAT TYMNET [
	DEST[CLR-DEV-FROM-INTR] PUSHJ[TYMCLK] C600 $
	  ;Start up TYMNET interface if needed.
];TYMNET
	DEST[CLR-DEV-FROM-INTR] JUMP[APRCHK] C600 $ 	
	  ;Cause PI on APR channel if enabled, and exit.

CLKRDFLG:  ;Put hardware 60HZ CLK FLAG into AR35.
	START-IN D[CONST 6] DEST[DEV-ADR] NORM $
	  ;Select device 6.
	MAPF[5] D[IOD] ROT[34. + 1] MASK[1] DEST[AR] CYLEN[IOB-IN] POPJ $
	  ;Get bit and return.

.REPEAT NTP [ ;Ucode for KENNEDY or PERTEC formatter and DMA tape controller.

  .REPEAT 1 - TAPE [
.INSERT CFKNYD.SLO
  ]

  .REPEAT TAPE [  ;New (DMA tape controller, Pertec compatible fmtr )
.INSERT TAPE.SLO
  ]

  ] ;NTP
.REPEAT KNYTAPE [ ;KENNEDY TAPE CONTROL UCODE
.INSERT CFKNYP.SLO
 ] ;ENDX OF KENNEDY TAPE CODE
.REPEAT TLXTAPE [ ;TELEX TAPE CONTROL UCODE
.INSERT CFTLX.SLO
] ;ENDX OF TELEX TAPE CODE
.REPEAT SLOWTAPE [ ;UCODE FOR BARE 800 BPI TAPE DRIVE
.INSERT CFBARE.SLO
   ] ;END OF SLOW TAPE CODE
.REPEAT 125TAPE [ ;UCODE FOR BARE 800 BPI, 125 IPS TAPE DRIVE
.INSERT CFB125.SLO
] ;END OF SLOW 125 IPS TAPE CODE
;TAPE DISPATCH

 .REPEAT 1 - XUCODE [ ;If we have extended ucode memory, these are different.

.OPCODE[725]	;TAPE IOTS

;725 - Obsolete version of read (no word count, E = core address.)
	D[CONST 7] DEST[DEV-ADR] NORM COND[-USER] LBJUMP[TAPERD] $
	 NOP $
;726 - MTAPE
	D[CONST 7] DEST[DEV-ADR] NORM JUMP[TAPEMT] $	
	 NOP $
;727 - READ STATUS
	D[CONST 7] DEST[DEV-ADR] NORM JUMP[TAPERS] $	
	 NOP $
;730 - READ 1 RECORD, STORE UP TO (AC) WORDS STARTING E.
	D[CONST 7] DEST[DEV-ADR] NORM COND[-USER] LBJUMP[TAPENR] $
	 NOP $
;731 - WRITE 1 record of E words starting from CORE LOC IN AC.
	D[CONST 7] DEST[DEV-ADR] NORM COND[USER] JUMP[UTAPWR] $
	 NORM JUMP[TAPEWR] $
;732 - READ 1 record, store up to E words starting at (AC).
	D[CONST 7] DEST[DEV-ADR] NORM COND[-USER] LBJUMP[TAPERX] $
	 NOP $
  ] ;1 - XUCODE


 .REPEAT XUCODE [ ;If we don't have extended ucode memory, these are different.

.OPCODE[725]	;TAPE IOTS

;725 - Obsolete version of read (no word count, E = core address.)
	GETADR[TAPERD] JUMP[TAPDSP] $
;726 - MTAPE
	GETADR[TAPEMT] JUMP[TAPDSP] $
;727 - READ STATUS
	GETADR[TAPERS] JUMP[TAPDSP] $
;730 - OBSOLETE ! --read 1 record, store up to (AC) words starting at E.
	GETADR[TAPENR] JUMP[TAPDSP] $
;731 - WRITE 1 record of E words starting from CORE LOC IN AC.
	GETADR[TAPEWR] JUMP[TAPDSP] $
;732 - READ 1 record, store up to E words starting at (AC).
	GETADR[TAPERX] JUMP[TAPDSP] $

  ] ;XUCODE

.RELOC

TAPDSP:	D[CONST 7] DEST[DEV-ADR] COND[-USER] JUMP[GOHIGH] $
	 ;Load device code for tape, test for user mode.
	UIOTRP[MUUO] $
	 ;In user mode-- trap unless IOT USER

GOHIGH:	 ;Jump into high part of umemory, using 12-bit addr. in Q
	D[CONST (XUCODE * 10) + 2] ROT[9.] ALU[D+1] C600 SDISP $
	  ;This takes us to loc. 2001 and pre-sets the 10000 bit.
 .ORG[2001]
	D[CONST XUCODE] ROT[12.] ALU[DORQ] SDISP $
	  ;This finally takes us to loc. 10000+[Q] 

 .RELOC

  .REPEAT XUCODE [
.USE[HIGHMEM] $
     ]

 .PAIR
HIGHSMAIN:
	D[MEM] ACSEL[MA] DEST[AC] NORM JUMP[GOMAIN] $
	NORM JUMP[GOMAIN] $

GOMAIN:	GETADR[MAIN]  $	;Do extended mode jump to MAIN.

GOLOW:	 ;Jump to loc. in lower 4K indicated by contents of Q.

   .REPEAT XUCODE [
	ALU[0] C600 SDISP $
	 ;This goes to loc. 10000 and pre-clears the 10000 bit.
 .ORG[10000]
   ] ;XUCODE

	C600 ALU[Q] SDISP $
	 ;Now we actually go to low u-mem.

.USE[OTHER]



;------------------------------------------------------------------------------
;
;	FooVision
;
;------------------------------------------------------------------------------
.REPEAT VID [
.INSERT VID.SLO
];VID
	.OPCODE[766]
.REPEAT ((1 - VID) * (773 - 766 + 1)) [
	ILGIOT $			;OPS 766:773
	NOP $
];1-VID
.REPEAT VID [
	ILGIOT $			;OP 766 = illegal (reserved)
	NOP $
	GETADR[VIDDPA] JUMP[GOHIGH]$	;OP 767 = DPYADD
					;Note: GETADR expands to 2 words
	FIXM2$				;OP 770 = VIDIN
	D[CONST 36] DEST[DEV-ADR] JUMP[VIDIN]$
	FIXM1$				;OP 771 = VIDOUT
	D[CONST 36] DEST[DEV-ADR] JUMP[VIDOUT]$
	GETADR[VIDDPI] JUMP[GOHIGH]$	;OP 772 = DPYINI
					;Note: GETADR expands to 2 words
	GETADR[VIDDPO] JUMP[GOHIGH]$	;OP 773 = DPYOUT
					;Note: GETADR expands to 2 words
];VID
	.RELOC


;FLOATING POINT, KA10 STYLE.
;NONDISPATCH CODE.
.DEFINE CFPLOW[] [D[AR] ACSEL[AC+1] DEST[AC] JUMP[FPLOW] NORM ]
.DEFINE JINSEXP[] [D[AR] ROT[27.] DEST[Q] JUMP[INSEX1] NORM ]
.DEFINE CINSEXP[] [D[AR] ROT[27.] DEST[Q] PUSHJ[INSEX1] NORM ]
.DEFINE CFDS[] [D[MEM] ALU[D#AC] DEST[AR] PUSHJ[FDS1] NORM]

;***** DON'T USE A-MEM 0 FOR ANYTHING BESIDES DISPATCHES!!!	TVR-Sep80  *****
;***** This must be fixed!!!!					TVR-Sep80  *****
UFA1:	ALU[AC] DEST[0 AR] DEST-A-MEM PUSHJ[FADSUB] NORM $
	D[10] DEST[AR O_AC] SHORT $
	D[AR] ACSEL[AC+1] DEST[AC MA] SPEC[MA_PC] JUMP[MAIN1] $

	.PAIR	;: 6460		;.PAIR
DFN1:	ALU[NOTAC] DEST[AC] JUMP[. + 2] NORM $
	ALU[0-AC] DEST[AC] SHORT $
	D[MEM] DEST[Q] SHORT $
	D[MASK 9] ROT[27.] ALU[D&Q] DEST[Q] SHORT $
	D[AR] MASK[27.] ALU[DORQ] DEST[MEMSTO] MEMSTMA $

FSCZAP:	ALU[0] DEST[MA AC] SPEC[MA_PC] JUMP[MAIN1] NORM $
FSC1:	D[AR] MASK[9] ROT[9] DEST[Q AR] SHORT $
	D[MASK 8] ROT[27.] ALU[-D&AC] DEST[AC] COND[-OBUS<0] JUMP[FSC2] C550 $
	D[MASK 9] ALU[D#Q] DEST[Q AR] SHORT $
	D[MASK 8] ROT[27.] ALU[DORAC] DEST[AC] SHORT $
FSC2:	D[MA] MASK[18.] ALU[D+Q] DEST[IR-ADR] SHORT $
	ALU[0] DEST[Q] PUSHJ[NRMLIZ] NORM $
	CINSEXP $
	SPEC[MA_PC] DEST[MA] JUMP[MAIN1] NORM $

FAOS1:
FAOS5:
	ALU[AC] DEST[AR] PUSHJ[FADSUB] NORM $
	DEST[MA] SPEC[MA_PC] JUMP[MAIN1] NORM $
FAOS2:	ALU[AC] DEST[AR] PUSHJ[FADSUB] NORM $
	CFPLOW $
FAOS3:	ALU[AC] DEST[AR] NORM $
	D[CONST 11] DEST[DEV-ADR] SHORT $
	ALU[AC] DEST[0] DEST-A-MEM PUSHJ[FADSUB] NORM $
	D[10] DEST[MEMSTO O_AC] MEMST $
FAOS4:	ALU[AC] DEST[AR] PUSHJ[FADSUB] NORM $
	ALU[AC] DEST[MEMSTO] MEMST $

FMP1:
FMP5:
	ALU[AC] DEST[AR] PUSHJ[FM] NORM $
	SPEC[MA_PC] DEST[MA] JUMP[MAIN1] NORM $
FMP2:	ALU[AC] DEST[AR] PUSHJ[FM] NORM $
	CFPLOW $
FMP3:	ALU[AC] DEST[AR] NORM $
	D[CONST 11] DEST[DEV-ADR] SHORT $
	ALU[AC] DEST-A-MEM PUSHJ[FM] DEST[0] NORM $
	D[10] DEST[MEMSTO O_AC] MEMST $
FMP4:	ALU[AC] DEST[AR] PUSHJ[FM] NORM $
	ALU[AC] DEST[MEMSTO] MEMST $

;Macro to test for divide by zero
.DEFINE DIVTST[] [D[MEM] MASK[27.] COND[OBUS=0] JUMP[FPNDIV] C550]

;;;FD5:	D[MA] ROT[18.] DEST[HOLD] SPEC[LEFT] NORM $	;Not needed.  TVR-Apr80

;FDV,FDVR
FD1:	DIVTST $	;Check for divide by zero
	CFDS $
	SPEC[MA_PC] DEST[MA] JUMP[MAIN1] NORM $

;------------------------------------------------------------------------------
;LONG MODE FLOATING DIVIDE.
;------------------------------------------------------------------------------
FD2:	DIVTST $
 ;AR.0,IR.35:=XOR(DIVIDEND SIGN,DIVISOR SIGN).
	D[MEM] ALU[D#AC] DEST[AR] SHORT $
	D[AR] MASK[1] ROT[1] DEST[IR-ADR] SHORT $
 ;Flush sign & exponent from Dividend Low
	D[MASK 27.] ALU[D&AC] ACSEL[AC+1] DEST[AR] SHORT $
	D[AR] ROT[9] DEST[AC] ACSEL[AC+1] SHORT $
 ;Positive form of Dividend to AC, AR; original form to AMEM[1]
	ALU[AC] DEST[AR 1] DEST-A-MEM COND[-OBUS<0] JUMP[FD2A] CYLEN[C450] $
	ALU[0-AC] ACSEL[AC+1] DEST[AC] COND[OBUS=0] JUMP[. + 2] C550 $
	ALU[NOTAC] DEST[AC AR] JUMP[. + 2] SHORT $
	ALU[0-AC] DEST[AC AR] NORM $
FD2A:	D[CONST 1] ROT[27.] ALU[AC+D] DEST[AR] NORM $
	 ;Add 1 to exp. of dividend, since we will do only a 27-bit divide.
	ALU[AC] ACSEL[AC+1] DEST[6] DEST-A-MEM NORM $
	 ;Put low-order mantissa in AMEM[6] for FD.
	D[CONST 27.] LLOAD NORM $ 
	 ;Do only a 27-bit divide, so remainder will come out right.
	PUSHJ[FD] NORM $	
	 ;Perform the divide (returns: AC=quotient, AMEM[6]=remainder)
 ;AC+1 gets 0 if remainder = 0.
	D[16] ACSEL[AC+1] DEST[AC] COND[OBUS=0] JUMP[FD2D] C550 $
 ;Calculate exponent of remainder.
	D[11]  DEST[Q] C550 -OBUS<0 JUMP[. + 3] $
	 ;Check sign of dividend, jump if positive.
	 ALU[0-Q] DEST[1] DEST-A-MEM NORM $
	  ;Negate the dividend (so the exponent will be in pos. form)
	 ACSEL[AC+1] ALU[0-AC] DEST[AC] NORM $
	  ;Negate the remainder.
	D[11] ROT[9.] MASK[8] DEST[Q] NORM $
	 ;Recover exp. of dividend.
 ;A-MEM[7] has (dividend HOW)-(divisor).
	D[17] COND[-OBUS<0] JUMP[. + 2] C550 $
	 D[CONST 1] ALU[Q-D] DEST[Q] SHORT $
	D[CONST 26.] ALU[Q-D] DEST[Q] COND[OBUS18] JUMP[FD2C] C600 $
	 ;Jump if exponent underflow.
.DEFINE SWAPAC[] [ ;Interchange (AC) and (AC+1)
	ALU[AC] ACSEL[AC+1] DEST[AR] SHORT $
	D[AR] DEST[AR O_AC] SHORT $
	D[AR] ACSEL[AC+1] DEST[AC] SHORT $
  ]

 ;SWAP QUOTIENT (AC) AND REMAINDER (AC+1)
	SWAPAC
 ;INSERT EXPONENT INTO REMAINDER.
	ALU[Q] DEST[AR] PUSHJ[INSEXP] NORM $
	SWAPAC
FD2D:	SPEC[MA_PC] DEST[MA] JUMP[MAIN1] NORM $

FD2C:	ALU[0] ACSEL[AC+1] DEST[AC MA] SPEC[MA_PC] DEST[MA] JUMP[MAIN1] NORM $

FD3:	DIVTST $
	ALU[AC] DEST[0] DEST-A-MEM PUSHJ[FDS] NORM $
	D[10] DEST[MEMSTO O_AC] MEMST $
FD4:	DIVTST $
	CFDS $
	ALU[AC] DEST[MEMSTO] MEMST $

;HERE ON DIVISOR=0.  SET NO DIVIDE, OVF,FLOV,RETURN.
FPNDIV:	D[PC] DEST[Q] SHORT $
	D[CONST 1] ROT[23.] ALU[DORQ] DEST[Q] PUSHJ[SETFOV] NORM $
	DEST[MA] SPEC[MA_PC] JUMP[MAIN1] NORM $

;------------------------------------------------------------------------------
;NORMALIZE DOUBLE PRECISION NUMBER IN AC,Q WHOSE EXPONENT
; IS IN IR-ADR.  LEAVE EXPONENT IN AR, NORMALIZED NUMBER IN AC,Q.
; IF NUMBER IS 0, LEAVE 0 IN AR,AC, AND Q.
;------------------------------------------------------------------------------
.DEFINE CNORM[] [D[AR] DEST[AC] PUSHJ[NRMLIZ] NORM]

;A. Return immediately if 0.
NRMLIZ:	ALU[QORAC] DEST[AR] COND[OBUS=0] POPJ C550 $
;B. Check for mantissa overflow, move exponent to AR.
	ALU[AC] DEST[AR] PUSHJ[NORMOV] NORM $
		;Check mantissa and shift right if necessary
	D[IR] MASK[18.] COND[-OBUS=0] POPJ C550 $
		;If we adjusted right, then we definitely don't have to
		;shift left.  We're done here.
;C. Left shift until normalized.
	ALU[AC] COND[OBUS<0] JUMP[NEGNOR] CYLEN[C450] $
		;Separate into two cases, positive and negative
POSNOR:	D[CONST 1] ROT[26.] ALU[D&AC] COND[-OBUS=0] POPJ C550 $
		;If high order bit of mantissa is one, we're done
	D[AR] ALU[D-1] DEST[AR] SHORT $
		;Decrement the exponent
	ALU[SH-AC] MASK[2] DEST[D6] JUMP[POSNOR] NORM $
		;Shift left and try again.
NEGNOR:	D[CONST 1] ROT[26.] ALU[D&AC] COND[OBUS=0] JUMP[NN1] C550 $
		;If high order bit of mantissa is zero, we're done
	D[AR] ALU[D-1] DEST[AR] SHORT $
		;Decrement the exponent
	ALU[SH-AC] MASK[2] DEST[D6] JUMP[NEGNOR] NORM $
		;Shift left and try again.
NN1:	D[MASK 27.] ALU[D&AC] COND[-OBUS=0] POPJ C550 $
		;Check for case of exactly -(2^n).  If it isn't, we're done
	D[CONST 1] ROT[26.] ALU[DORAC] DEST[AC] SHORT $
		;We went one too far, backup by simply OR'ing in the relevant
		;bit in the same manner as shifting would. 
		;(*** What about Q??  TVR-Jul80)
	D[AR] ALU[D+1] DEST[AR] POPJ NORM $
		;Increment exponent to account for simulated left shift.

;------------------------------------------------------------------------------
;CHECK FOR MANTISSA OVERFLOW INTO EXPONENT FIELD.  CALL WITH
; AR&AC,Q: # TO NORMALIZE, IR-ADR: ITS EXPONENT.
; LEAVE EXPONENT IN AR.  SET IR-ADR=0 IF NO OVERFLOW.  SET IR-ADR<>0
; IF OVERFLOW, AND NORMALIZE.
;
;M.O. <=> [AR0<>AR8] OR [(AR8=1) AND (AR9-35=0)]
;------------------------------------------------------------------------------
NORMOV:	D[AR] ROT[8] ALU[D#AC] COND[OBUS<0] JUMP[NOVYES] C550 $
		;Check to make sure AR<0>=AR<8>.  If they don't, the mantissa
		;clearly overlaps the exponent field.
	D[MASK 27.] ALU[D&AC] COND[-OBUS=0] JUMP[NOVNO] C550 $
		;Check for AR<9:35> for zero.  If not zero, we're OK
	D[CONST 1] ROT[27.] ALU[D&AC] COND[OBUS=0] JUMP[NOVNO] C550 $
		;Check AR<8>.  If zero, we're OK
;	\ /
;Mantissa has overflowed, adjust it.  Right by one should be enough.
NOVYES:	ALU[SH-AC] MASK[1] DEST[D4] SHORT $
		;Shift mantissa right (i think?)
	D[IR] MASK[18.] ALU[D+1] DEST[AR IR-ADR] POPJ NORM $
		;Increment mantissa and flag that we changed it by setting
		;IR<18:35> to be non-zero.

;Mantissa has not overflowed.
NOVNO:	D[IR] MASK[18.] DEST[AR] SHORT $
		;Save exponent in AR
	ALU[0] DEST[IR-ADR] POPJ NORM $
		;Zero IR<18:35> to signify success

;------------------------------------------------------------------------------
;INSERT EXPONENT IN AR INTO WORD IN AC.
;SET FLOV,FLUN,OVF FLAGS AS REQUIRED.
;PRESERVES AR, CLOBBERS Q.
;------------------------------------------------------------------------------
INSEXP:	D[AR] ROT[27.] DEST[Q] NORM $
		;Move exponent into position
INSEX1:	D[MASK 8.] ROT[27.] ALU[D&Q] DEST[Q] SHORT $
		;Flush stuff in mantissa area
	ALU[Q#AC] DEST[AC] SHORT $
		;Fill in exponent (complementing it if (AC) is negative !)
	D[AR] COND[OBUS18] JUMP[EXPUF] C550 $
		;Check for underflow (i.e. below range of exponent offset)
	D[AR] MASK[10.] ROT[28.] COND[OBUS=0] POPJ C550 $
		;Check for overflow (i.e. above range of exponent offset)
	D[PC] DEST[Q] SHORT $
		;Setup to set floating overflow
SETFOV:	D[CONST 11] ROT[32.] ALU[DORQ] DEST[CRYOV] POPJ NORM $
		;Turn on overflow and floating overflow
EXPUF:	D[PC] DEST[Q] SHORT $
		;Setup to set no divide and floating overflow
	D[CONST 1] ROT[24.] ALU[DORQ] DEST[Q] JUMP[SETFOV] NORM$
		;Turn on no divide, then do overflows

;------------------------------------------------------------------------------
;FLOATING ADD AC&AR TO MEM.  RESULT, NORMALIZED AND ROUNDED
; IF REQUIRED IN AC,Q.
;------------------------------------------------------------------------------
.DEFINE BLEXPS[DES1 TIME DES2] [
	D[MASK 8] ROT[27.] ALU[DORAC] DEST[DES2] COND[OBUS<0] JUMP[. + 2] C550 $
	D[MASK 8] ROT[27.] ALU[-D&AC] DEST[DES2] SHORT $
	D[MEM] DEST[Q] COND[OBUS<0] JUMP[. + 2] C550 $
	D[MASK 8] ROT[27.] ALU[-D&Q] DEST[DES1] JUMP[. + 2] NORM $
	D[MASK 8] ROT[27.] ALU[DORQ] DEST[DES1] CYLEN[TIME] $
];BLEXPS
	;A. + FORM EXPONENT OF AC,MEM RTO AR,Q RESP.
FADSUB:	D[AR] MASK[9] ROT[9] DEST[Q AR] SHORT $
FADSU1:	D[CONST 1] ROT[8] ALU[D&Q] COND[OBUS=0] JUMP[FS1] C550 $
	D[MASK 9] ALU[D#Q] DEST[AR] SHORT $
FS1:	D[MEM] MASK[9] ROT[9] DEST[Q] SHORT $
	D[CONST 1] ROT[8] ALU[D&Q] COND[OBUS=0] JUMP[FS2] C550 $
	D[MASK 9] ALU[D#Q] DEST[Q] SHORT $
	;B. COMPUTE DIFFERENCE, SWAP OPRANDS IF AC HAS LARGER EXP.
	;   LEAVE + DIFFERENCE IN Q, DIFF -1 IN LOOP CTR.
	;   LEAVE LARGER EXPONENT IN IR-ADR.
FS2:	ALU[Q] DEST[IR-ADR] SHORT $
	D[AR] ALU[Q-D] DEST[Q] COND[-OBUS<0] JUMP[FS3] C600 $
	D[AR] DEST[IR-ADR] SHORT $
	D[MEM] DEST[HOLD O_AC] NORM $
	ALU[0-Q] DEST[Q] NORM $
FS3:	ALU[Q-1] DEST[AR] LLOAD NORM $
	;C. BLANK EXPONENTS.
	BLEXPS[HOLD NORM AC]
	;D. IF DELTA EXPONENTS >62., AC GOES TO OBLIVION.
	D[AR] ALU[D+1] DEST[Q] COND[OBUS=0] JUMP[FS5] C600 $
	D[CONST 63.] ALU[Q-D] COND[OBUS<0] JUMP[FS4] C600 $
	ALU[0] DEST[AC] SHORT $
	ALU[0] DEST[Q] JUMP[FS5] NORM $
FS4:	ALU[0] DEST[Q] SHORT $
	ALU[SH-AC] DEST[D4] MASK[1] LOOP [.] NORM $
	;E. ADD.
FS5:	D[MEM] ALU[D+AC] DEST[AR] SHORT $
	;F. NORMALIZE RESULT.
	D[IR] DEST[AC] SHORT $	;CHECK FOR UFA
	D[CONST 1] ROT[40] ALU[D&AC] COND[OBUS=0] JUMP[UFANOR] C550 $

;------------------------------------------------------------------------------
;ENTER HERE WITH RESULT IN AR,Q, EXP IN IR-ADR.
;------------------------------------------------------------------------------
FPNAR:	CNORM $				;NOPE, NORMALIZE
;(Calls NRMLIZ which changes register usage from above and adjusts various
;things.  "LEAVE EXPONENT IN AR, NORMALIZED NUMBER IN AC,Q.")
;G. ROUND IF NECESSARY, INSERT EXPONENT INTO HIGH ORDER WORD OF RESULT.
	ALU[Q] COND[-OBUS<0] DEST[HOLD] JUMP[NORND] CYLEN[C450] $
		;Save Q in HOLD (i.e. MEM)
		;If Q<0> is zero, don't round
	D[IR] DEST[Q] NORM $
		;Get Q so we check bit meaning rounding (??? Can't this be
		;done with D[IR] ROT[7] COND[OBUS<0]... ???)
	D[CONST 1] ROT[35] ALU[D&Q] COND[OBUS=0] JUMP[NORND] C550 $
		;Check opcode to see if rounding is requested.
		;If not, we're done
	D[MEM] DEST[Q] SHORT $
		;Restore Q
	D[MASK 43] ALU[D&Q] COND[-OBUS=0] JUMP[YESRND] C550 $
		;Round if Q<1:35> is non-zero (? what does this signify???)
	ALU[AC] COND[OBUS<0] JUMP[INSEXP] CYLEN[C450] $
		;If mantissa is negative, we don't round (???)
;	\ /
YESRND:	D[AR] DEST[IR-ADR] SHORT $
		;Setup IR for NRMLIZ
	ALU[AC+1] DEST[AC] PUSHJ[NRMLIZ] NORM $
		;Increment high order word and normalize once more (???)
	JINSEXP $
		;Now stick in exponent
;	---
NORND:	D[MEM] DEST[Q] JUMP[INSEXP] NORM $
		;Restore Q and insert exponent(?)

;UFA NORMALIZATION -- ONLY ON MANTISSA OVERFLOW.
UFANOR:	D[AR] ALU[DORQ] DEST[AC] COND[OBUS=0] POPJ C600 $
	D[AR] DEST[AC] PUSHJ[NORMOV] NORM $
	JINSEXP $
;	---

;------------------------------------------------------------------------------
;SETUP LOW ORDER FP RESULT, STORE BOTH IN AC,AC+1
;ENTER WITH LOW WORD IN MEM, HIGH WORD IN AC, HIGH
;WORD'S EXPONENT IN AR&AC+1.
;------------------------------------------------------------------------------
FPLOW:	D[CONST 27.] ACSEL[AC+1] ALU[AC-D] DEST[AC AR] SHORT $
	D[CONST 1] ROT[7] ACSEL[AC+1] ALU[D&AC] COND[-OBUS=0] JUMP[ZLOW] C550 $
	D[MEM] ROT[27.] MASK[27.] DEST[Q] COND[OBUS=0] JUMP[ZLOW] C550 $
	D[AR] ROT[27.] ACSEL[AC+1] DEST[AC] SHORT $
	D[MASK 8] ROT[27.] ALU[D&AC] ACSEL[AC+1] DEST[AC] SHORT $
	ACSEL[AC+1] ALU[QORAC] DEST[AC MA] SPEC[MA_PC] JUMP[MAIN1] NORM $
ZLOW:	ACSEL[AC+1] ALU[0] DEST[AC MA] SPEC[MA_PC] JUMP[MAIN1] NORM $

;------------------------------------------------------------------------------
;
;	FLOATING MULTIPLY.  AC&AR BY MEM.
;
;*** This code produces non-zero results if MEM=-1.0 and AC=0  !!!    TVR-Jun80
;------------------------------------------------------------------------------
;A. SUM OF + FORM EXPONENTS -128.+1 TO IR-ADR.  +1 BECAUSE 28
; STEPS ARE USED TO PROVIDE ONE GUARD DIGIT.
FM:	D[AR] MASK[9] ROT[9] DEST[Q AR] NORM$
		;Extract the exponent from AC (which was copied into AR)
	D[CONST 1] ROT[8] ALU[D&Q] COND[OBUS=0] JUMP[FM1] C550 $
		;Check sign bit of number.  Nothing special if positive
	D[MASK 9] ALU[D#Q] DEST[AR] SHORT $
		;Sign is negative, we want the one-complement of the exponent
		;field to get the actual exponent.
FM1:	D[MEM] MASK[9] ROT[9] DEST[Q] SHORT $
		;Extract the exponent from MEM
	D[CONST 1] ROT[8] ALU[D&Q] COND[OBUS=0] JUMP[FM2] C550 $
		;Check sign bit of number.  Nothing special if positive
	D[MASK 9] ALU[D#Q] DEST[Q] SHORT $
		;Sign is negative, we want the one-complement of the exponent
		;field to get the actual exponent.
FM2:	D[AR] ALU[D+Q] CARRY DEST[Q] SHORT $
		;Add the two exponents
		;+1. FOR GUARD DIGIT.
	D[CONST 1] ROT[7] ALU[Q-D] DEST[IR-ADR] SHORT $
		;Account for exponent bias.  Put exponent in a safe place.
;B. BLANK EXPONENTS.
	BLEXPS[Q SHORT AR]
		;Extend the sign to blank out the exponent field.  We will
		;now have perfectly good integers here, of 27 bit magnitude
		;(assuming that the numbers were normalized to begin with).
	ALU[0] DEST[AC] PUSHJ[TESMUL] NORM $ ;28. STEPS.
;;;	ALU[Q] DEST[AR] SHORT $	;FLUSH SIGN IN LO WD.
	D[MASK 7] ALU[-D&Q] DEST[Q AR] SHORT $	;FLUSH SIGN IN LO WD.
		;Flush remenants of multiplier in low order part of
		;word.  MASK field determined empirically (35-28???)
	D[AR] ALU[D+Q] DEST[Q] SHORT $
		;Make low order word unsigned.
	ALU[AC] DEST[AR] JUMP[FPNAR] NORM $

;28. STEP INTEGER MULTIPLY FOR USE BY FM.
TESMUL:	D[CONST 27.] LLOAD NORM $	;LOOP 28 TIMES
	JUMP[DOMUL1] NORM $	;TEST.

;------------------------------------------------------------------------------
;SHORT STYLE FLOATING DIVIDE AC BY MEM.
; XOR OF DIVISOR&DIVIDEND SIGNS IN AR BIT 0.
;------------------------------------------------------------------------------
FDS:	D[MEM] ALU[D#AC] DEST[AR] SHORT $
FDS1:	D[AR] MASK[1] ROT[1] DEST[IR-ADR] SHORT $
	ALU[AC] DEST[AR] COND[-OBUS<0] JUMP[. + 2] C550 $
	ALU[0-AC] DEST[AC AR] SHORT $
	ALU[0] DEST[6] DEST-A-MEM NORM $
	D[CONST 28.] LLOAD NORM $ 
		;Do only a 28-bit divide.

;------------------------------------------------------------------------------
;	Floating Divide
;
; DIVIDEND HIGH ORDER WORD IN AR, LOW IN A-MEM[6]. DIVISOR IN MEM.
; BOTH IN POSITIVE FORM.  IR.35=XOR(DIVIDEND SIGN,DIVISOR SIGN).
;------------------------------------------------------------------------------
FD:
;A. PUT DIVISOR IN + FORM, GET DIVISOR EXPONENT.
;.1 Shuffle IR.35 into A-MEM[4].
	D[IR] MASK[18.] DEST[4] DEST-A-MEM NORM $
		;Save IR-ADR in A-MEM
	D[MEM] DEST[Q] COND[-OBUS<0] JUMP[. + 2] C550 $
		;Check for negative divisor
	D[MEM] ALU[0-D] DEST[Q HOLD] NORM $
		;Negate divisor
	D[MEM] ROT[9] MASK[8] DEST[IR-ADR] NORM $
		;Extract exponent from divisor, store in IR<18:35>
	D[MASK 8] ROT[27.] ALU[-D&Q] DEST[HOLD] NORM $
		;Extract mantissa from divisor
;B. Fetch and blank HOW Dividend exponent.
	D[AR] ROT[9] MASK[8] DEST[Q] NORM $
		;Extract dividend exponent.
	D[AR] MASK[27.] DEST[AC] SHORT $
		;Extract mantissa from dividend
;C. Compute resultant exponent.
	D[IR] MASK[18.] ALU[Q-D] DEST[Q] SHORT $
		;Subtract divisor exponent from dividend exponent
	D[CONST 1] ROT[7] ALU[D+Q] DEST[IR-ADR] NORM $
		;Include exponent offset
;D. Move LOW Dividend to Q.
	D[16] DEST[Q] SHORT $
;E. If divisor<=dividend,  shift dividend right, increment the
	; resultant exponent.  save diff. in A-MEM[7] for long mode.
	D[MEM] ALU[AC-D] DEST[7] DEST-A-MEM COND[-OBUS<0] JUMP[FDAD] C600 $
;F. Save exp in A-MEM[5]
FDSHFT:	D[IR] DEST[5] DEST-A-MEM NORM $
	PUSHJ[DODIV4] NORM $	
	 ;Do the divide. Result DOES NOT have signs adjusted.
;G. Save remainder in A-MEM[6], put quotient in AC, AR; put 0 in Q.
	ALU[AC] DEST[6] DEST-A-MEM NORM $
	ALU[Q] DEST[AC AR] SHORT $
	ALU[0] DEST[Q] SHORT $
;H. Prepare to round 28. bit result.
	ALU[SH-AC] MASK[1] DEST[D4] SHORT $
	 ;Shift AC,Q rt 1 bit
	D[15] ALU[D-1] DEST[IR-ADR] NORM PUSHJ[FPNAR] $	
	 ;Move exp for FPNAR, normalize and insert exponent into quotient.
	D[14] MASK[1] C550 OBUS=0 POPJ $
	 ;Done if positive result.
	ALU[0-AC] DEST[AC] NORM POPJ $
	 ;Negate quotient.
;------------------------------------------------------------------------------
;HERE WHEN DIVIDEND IS >= DIVISOR.  SHIFT DIVIDEND RIGHT
; AND INCREMENT RESULTANT AC.  THIS WILL ALLOW DIVIDE TO
; SUCCEED IF BOTH DIVISOR & DIVIDEND WERE NORMALIZED
; AND DIVISOR <> 0.
;------------------------------------------------------------------------------
FDAD:	ALU[SH-AC] MASK[2] DEST[D4] SHORT $
	D[IR] MASK[18.] ALU[D+1] DEST[IR-ADR] JUMP[FDSHFT] NORM $

;ADJSP1 ADJSP2 DMOVE2 DMOVN2 DMOVM2 DMVNM2 DMVNM3 DMVNM4 DMVNM5 KAFIXP KAFIXN FIXR1 KIFIX1 FIXRN KIFIXN FIXER FIXER1 FIXER2 FIXER3
;
;Strays from KI instructions
;

.REPEAT XUCODE [
 .USE[AREA50]  ;Squeeze this stuff into the space vacated by MBOOT.
    ]

;(ADJSP continued)
;Left result is negative.  Check right side.
ADJSP1:	D[IR] MASK[22] ALU[D+AC] DEST[AR] NORM $
		;Add right half
	D[MASK 22] ALU[-D&Q] DEST[Q] SHORT $
		;Isolate left half
	D[AR] MASK[22] ALU[DORQ] DEST[O_AC AR] NORM $
		;Merge halves and store
	D[IR] COND[-OBUS18] SPEC[MA_PC] DEST[MA] JUMP[MAIN1] C550 $
		;If E was positive, it wasn't an overflow (just a bad idea)
		;Start fetching next instruction
	D[AR] COND[OBUS<0] JUMP[MAIN] C550 $
		;If original was negative, we're OK.  Start doing next
		;instruction if no sign changed in left half
	JUMP[PDLO6] NORM $
		;ADJSP got a PDLOV
;ADJSP left result positive
ADJSP2:	D[MASK 22] ALU[-D&Q] DEST[Q] SHORT $
		;Isolate left half
	D[AR] MASK[22] ALU[DORQ] DEST[O_AC AR] $
		;Merge halves and store
	D[IR] COND[OBUS18] SPEC[MA_PC] DEST[MA] C550 $
		;If E was negative, it wasn't an overflow (just a bad idea)
		;Start fetching next instruction
	D[AR] COND[-OBUS<0] JUMP[MAIN1] C550 $
		;If original was positive, we're OK.  Start doing next
		;instruction if no sign changed in left half
	JUMP[PDLO6] NORM $
		;ADJSP got a PDLOV

;(DMOVE continued)
DMOVE2:	D[MA] ALU[D+1] DEST[MA] NORM $	;Fetch second word
	FIXM1 $			;Complete fetch
	ACSEL[AC+1] D[MEM] DEST[AC MA] SPEC[MA_PC] JUMP[MAIN1] CYLEN[FIXM+1] $
		;Put it in the second AC and start next instruction

;(DMOVN continued)
DMOVN2:	D[MA] ALU[D+1] DEST[MA] NORM $	;Fetch second word
	FIXM1 $	;Complete fetch
	ACSEL[AC+1] D[MEM] ALU[0-D] DEST[AC MA] SPEC[MA_PC] CYLEN[FIXM+1] $
		;Negate low order word and put it in the second AC
		;Start next instruction fetch (Note that DEST[MA] is
		;really associated with SPEC[MA_PC])
		;*** Is FIXM+1 really the right thing???
	ACSEL[AC+1] D[MASK 1] ROT[35.] ALU[-D&AC] DEST[AC]
			COND[-OBUS=0] JUMP[MAIN1] NORM $
		;Clear stupid bit 0.
		;If the low order part is non-zero, we're done
	ACSEL[AC] ALU[AC+1] DEST[AC] SPEC[CRYOV] JUMP[MAIN1] C550 $
		;Increment high order word and we're finally done.

;(DMOVEM continued)
	.PAIR
DMOVM2:	CYLEN[MEMSTO] ACSEL[AC] D[MEM] DEST[AC] NORM $
		;Write it also in the AC
	CYLEN[MEMSTO] D[MA] ALU[D+1] DEST[MA] $
		;Setup to write second word
	ACSEL[AC+1] ALU[AC] DEST[MEMSTO] MEMST $
		;Write secord word.

;(DMOVNM continued)
DMVNM2:	ACSEL[AC+1] ALU[0-AC] DEST[Q] SHORT $
		;Negate low order word.
	ACSEL[AC+1] D[MASK 1] ROT[35.] ALU[-D&Q] DEST[Q]
			COND[-OBUS=0] JUMP[DMVNM4] NORM $
		;Clear stupid bit 0.
		;If the low order part is non-zero, no change needed to
		;high order word.
	D[AR] ALU[AC+1] DEST[AR STRT-WRT] SPEC[CRYOV]
		COND[-MA-AC] JUMP[DMVNM5] NORM $
		;Increment high order word and start first store
DMVNM3:	ACSEL[MA] D[MEM] DEST[AC] JUMP[DMVNM5] $
		;Store is to an AC, write into 2901.
DMVNM4:	DEST[STRT-WRT] COND[MA-AC] JUMP[DMVNM3] $
		;Start first store.  Jump if to an AC
DMVNM5:	D[MA] ALU[D+1] DEST[MA] NORM $
		;Finish write.  Note that due to FIXM2, we don't have to
		;worry about map faults.
		;Prepare for secord write
	ALU[Q] DEST[MEMSTO] MEMST $
		;Do final write (low order word into (E+1))

;KAFIX (Opcode 247) continued
;Positive number to fix
KAFIXP:	D[IR] ROT[27.] MASK[9.] DEST[Q] COND[-OBUS=0] PUSHJ[FIXER] $
		;Extract exponent adjustment factor and do fixing
	ACSEL[AC] ALU[Q] DEST[AC MA] SPEC[MA_PC] JUMP[MAIN1] NORM $
		;Put result into AC and we're done
;Negative number to fix
KAFIXN:	D[IR] ROT[27.] MASK[9.] DEST[Q] COND[-OBUS=0] PUSHJ[FIXER] $
		;Extract exponent adjustment factor and do fixing
;;;	ACSEL[AC] D[MASK R] ALU[D/#Q] DEST[AC MA]	;*** Assembler loses!
	ACSEL[AC] D[2] MASK[R] ALU[D/#Q] DEST[AC MA]	;Sigh...
			SPEC[MA_PC] JUMP[MAIN1] NORM $
		;Put sign extended result into AC and we're done

;(FIXR continued)
FIXR1:	D[MEM] COND[OBUS<0] JUMP[FIXRN] C550 $
		;Round different directions
	D[CONST 20] ROT[30.] ALU[D+Q] DEST[AC AR] PUSHJ[FADSUB] NORM $
		;Positive. Finish making constant 0.5 and add it
	D[CONST 33] DEST[Q] SHORT $
		;Start making magic constant
	ALU[AC] DEST[AR HOLD] JUMP[FIXR2] NORM $
		;Setup for FIXER.  Rest is same as KIFIX
;	---
FIXRN:	D[CONST 60] ROT[30.] ALU[D-Q] DEST[AC AR] PUSHJ[FADSUB] NORM $
		;Negative. Finish making constant -0.5 and add it
	D[CONST 33] DEST[Q] SHORT $
		;Start making magic constant
	D[CONST 2] ROT[6] ALU[DORQ] DEST[Q] SHORT $
		;Finish making magic constant
	ALU[0-AC] DEST[AR HOLD] PUSHJ[FIXER] NORM $
		;Setup for FIXER
	ACSEL[AC] ALU[0-Q] DEST[AC MA] SPEC[MA_PC] JUMP[MAIN1] NORM $
		;Negate it back again and start next instruction
;	---
;(KIFIX continued)
KIFIX1:	D[MEM] DEST[AR] COND[OBUS<0] JUMP[KIFIXN] C550 $
		;Load up things for FIXER, check for positive mantissa
FIXR2:	D[CONST 2] ROT[6] ALU[DORQ] DEST[Q] PUSHJ[FIXER] NORM $
		;Finish making magic constant and do fix.
	ACSEL[AC] ALU[Q] DEST[AC MA] SPEC[MA_PC] JUMP[MAIN1] NORM $
		;Put result into AC and we're done
;	---
;	---
KIFIXN:	D[CONST 2] ROT[6] ALU[DORQ] DEST[Q] SHORT $
		;Finish making magic constant
	D[MEM] ALU[0-D] DEST[HOLD AR] PUSHJ[FIXER] NORM $
		;ABS to both MEM and AR.  Fix the number
	ACSEL[AC] ALU[0-Q] DEST[AC MA] SPEC[MA_PC] JUMP[MAIN1] NORM $
		;Negate it back again and start next instruction


;Fix a number (without sign extension) in MEM, AR=ABS(MEM), Q=magic number
;(233 for normal fix)
FIXER:	D[AR] ROT[9] MASK[9] ALU[D-Q] DEST[ROTR Q]
			COND[OBUS<0] JUMP[FIXER2] C550 $
		;Calculate number of positions to move
		;Jump if we'll be shifting right (n<2^26)
	D[CONST 27.] ALU[D+Q] DEST[MASKR] NORM $
		;Construct appropriate mask
	D[MEM] MASK[27.] DEST[HOLD] NORM $
		;Flush exponent, our mask won't reach.
	D[CONST 9.] ALU[Q-D] COND[OBUS<0] JUMP[FIXER1] C550 $
		;Check for overflow
;;; Set overflow here.  What kind?  (We can live without it for KAFIX, since it
;;; never did check, but when KIFIX is done, this will have to be corrected.)
	D[CONST 1] ROT[35.] ALU[Q] PUSHJ[QORCRY] NORM $
		;Set overflow flag.
	D[CONST 44] DEST[MASKR] NORM $
		;For those losers who want to see some of the number...
;Now that we know how much to shift things, do it and return.
FIXER1:	D[MEM] ROT[R] MASK[R] DEST[Q] NORM POPJ $
		;Gee, that was fast.
;Negative, shift count, the easy case.
FIXER2:	D[CONST 27.] ALU[D+Q] DEST[MASKR] COND[OBUS<0] JUMP[FIXER3] $
		;Construct appropriate mask.  If !x!<1, return zero
	D[CONST 36.] ALU[D+Q] DEST[ROTR] JUMP[FIXER1] NORM $
		;Hardware doesn't believe in negative shift counts
;Number is fractional, i.e. shift would go off the end.  Return zero
FIXER3:	ALU[0] DEST[Q MASKR] SHORT POPJ $
		;Just return zero.  Set mask just in case

.REPEAT XUCODE [
  .USE[OTHER]
   ]
;FLTR, continued
FLTR1:	D[CONST 33] DEST[Q] SHORT $
	D[CONST 2] ROT[6] ALU[DORQ] DEST[IR-ADR] NORM $
		;Make magic constant for exponent
	ALU[0] DEST[Q] PUSHJ[FPNAR] $
		;Clear low order word
		;Normalize and round (happens to have same bit on as FxxR)
		;Result goes to AC
	SPEC[MA_PC] DEST[MA] JUMP[MAIN1] NORM $
		;Start next instruction fetch


  .REPEAT WK [
		.INSERT WK.SLO
	  ]


;;; Device 6 service assembled regardless of whether Tymnet, DR-11,
;;; or neither is being supported.

;;; Define subdevices of the CFT board for the TYMNET interface
;;; The first two, if written, reset the interrupt requests.

  .REPEAT OTP [
TNODIFS = 2	;OUTPUT DONE INTERRUPT FF SUBSEL = REQ B
TNIRIFS = 4	;INPUT READY INTERRUPT FF SUBSEL = REQ A.
TYM.LD = 1	;MAPF value for loading output register.
TYM.RD = 0	;MAPF value for reading input register.
  ] ;OTP

  .REPEAT NTP [
TNODIFS = 17	;OUTPUT DONE INTERRUPT FF SUBSEL = REQ B
TNIRIFS = 16	;INPUT READY INTERRUPT FF SUBSEL = REQ A.
TYM.LD = 15	;MAPF value for loading output register.
TYM.RD = 5	;MAPF value for reading input register.
  ] ;NTP

;;; Location 2141 is where device 6 interrupts come.

TYMFOO = .
	.ORG[2141]
	;Prepare to call MAPOFF by re-loading DEV-ADR.
	D[CONST 1] DEST[DEV-ADR] NORM JUMP[TNI] $	

	.USE[TYMFOO] 

.REPEAT 1 - TYMNET - DR11P [
TNI:	DEST[CLR-DEV-FROM-INTR] JUMP[MAIN] $		;"It can't happen here"
];1 - TYMNET - DR11P

;;; Device 6 control register hacking.
;;; Register 1 in device 6's A memory contains the state of the
;;; control register, since we can't read it back.

;;; Q contains mask for bits not to be changed.  Remaining bits are cleared.
;;; On return, Q has new value of output register and AR is zeroed.
DEV6CL:	ALU[0] DEST[AR] NORM JUMP[DEV6ST] $

;;; Q contains mask for bits not to be changed.
;;; Remaining bits are loaded from AR.
;;; On return, Q has new value of output register.
DEV6ST:	D[CONST 6] DEST[DEV-ADR] NORM $
;;; Enter here if device address already set up to 6.
DEV6ST1: D[11] ALU[D&Q] DEST[Q] NORM $			;Get AMEM(1), mask it.
DEV6ST2: D[AR] ALU[DORQ] DEST[Q IOD] SPEC[IOB-OUT] NORM $	;Or in new data
	MAPF[TYM.LD] ALU[Q] DEST[1] DEST-A-MEM CYLEN[IOB-OUT] POPJ $

.REPEAT TYMNET [
.INSERT TYMNET.SLO
];TYMNET
.REPEAT DR11P [
.INSERT DR11.SLO
];DR11P

; SOMETHING IS REALLY FUCKED WITH THIS ASSEMBLER, CAUSING
; THE .USE, .RELOC, AND SO FORTH MACROS NOT TO WORK.
; EVIDENTLY THE PREVIOUS PERSON TO EDIT THE MICROCODE
; HAD PROBLEMS WITH THIS TOO.  MAYBE THIS WILL REMOVE THE SYMPTOM.

BULLSHIT = .
	.USE[BULLSHIT]
;INTERVAL TIMER CODE.

;a-mem useage:
;	0	dispatch addr for interrupts
;	1	pi chn (33: 35) and intrpt waiting flag (32)
;		(BITS 0,19 ARE ON FOR USE BY TAPE CODE)
;	2	CONSTANT W/ ONLY BIT 19 ON (USED BY TAPE CODE)
;	3	INTERVAL TIMER REGISTER.

  .REPEAT OTP [
	TIM.CLR.ROT = 35. - 6
	TIM.DO = 1
	TIM.DI = 1
	TIM.ENB = 1
	TIM.DEV = 7
	TIM.LOC = 2150
    ] ;OTP

  .REPEAT NTP [
	TIM.CLR.ROT = 0
	TIM.DO = 11
	TIM.DI = 1
	TIM.ENB = 10
	TIM.DEV = 5
	TIM.LOC = 2134
    ] ;NTP


	.ORG[TIM.LOC]		;$*$*$ INTRPTS FROM DEVICE COME HERE.
   .REPEAT 1 - TIMER [
	DEST[CLR-DEV-FROM-INTR] JUMP[MAIN] $ ;FLUSH DEV INTERRUPTS 
     ]

   .REPEAT TIMER [
	NORM JUMP[TIMINT] $
     ]

	.RELOC

TIMINT:   ;ALL DEV 5 INTS COME FROM INTERVAL TIMER...
	START-OUT D[CONST 1] ROT[TIM.CLR.ROT] DEST[IOD] NORM $
	   ;Clear the TIMER OVERFLOW FLAG.
	MAPF[TIM.ENB] D[13] DEST[Q] C800 $
	   ;Get TIMER REGISTER.
	D[CONST 1] ROT[12.] ALU[D+Q] DEST[Q 3] DEST-A-MEM
	          C550 COND[-CRY0] JUMP[MAIN] $
	   ;Increment the count by 2^12, exit if no overflow.
	D[11] MASK[3] DEST[AR] C550 COND[OBUS=0] JUMP[MAIN] $
	   ;Timer overflowed. ignore if no PI CHANNEL assigned.
	D[11] DEST[Q] NORM $
	   ;Get full contents of A-MEM[1].
	D[CONST 10] ALU[DORQ] DEST[1] DEST-A-MEM NORM JUMP[PIGEN] $
	   ;Set the "interrupting" status bit and generate a PI.

   .OPCODE[760]	;TIMER PSEUDO-IOT DISPATCH TABLE ENTRIES.

; TCONO -- 760
	D[CONST TIM.DEV] DEST[DEV-ADR] SHORT $
	D[11] DEST[Q] NORM JUMP[TCNO1]$
; TCONI -- 761
	D[CONST TIM.DEV] DEST[DEV-ADR] NORM PUSHJ[TCNI1] $ ;get bits.
	D[AR] DEST[MEMSTO] MEMST $ ;store them and return.
; TCONSO -- 762
	D[CONST TIM.DEV] DEST[DEV-ADR] NORM PUSHJ[TCNI1] $ ;get bits.
	D[MASK 22] ALU[D&Q] C550 COND[-OBUS=0] LBJUMP[DSKP1] $ ;Skip if on.
; TCONSZ -- 763
	D[CONST TIM.DEV] DEST[DEV-ADR] NORM PUSHJ[TCNI1] $ ;get bits.
	D[MASK 22] ALU[D&Q] C550 COND[OBUS=0] LBJUMP[DSKP1] $ ;Skip if off.
; TDATAO -- 764  LOAD THE 36-BIT TIMER
	D[CONST TIM.DEV] DEST[DEV-ADR] NORM $
	FIXM1 JUMP[TDATO] $
; TDATAI  --  765    READ TIMER REGISTER
	START-IN D[CONST TIM.DEV] DEST[DEV-ADR] NORM PUSHJ[TDTI] $ ;get bits.
	D[AR] DEST[MEMSTO] MEMST $ ;Store them and return.

   .RELOC

TCNO1:	D[MASK 32.] ROT[4] ALU[D&Q] DEST[Q] NORM $
	D[IR] MASK[3] ALU[DORQ] DEST[1] DEST-A-MEM JUMP[MAIN] $
	   ;Put new PI CHAN. in bits 33-35 of A-MEM[1].

TCNI1:	D[11] MASK[4] DEST[Q AR] NORM $ ;get intrpt flag and pi chn
	D[IR] ALU[D&Q] DEST[Q] NORM POPJ $ ;this is for conso, z

TDATO:	D[MEM] MASK[12.] DEST[Q] NORM $
	   ;Get low 12 bits of new timer value...
	START-OUT D[CONST 1] ROT[35. - 7] ALU[DORQ] DEST[IOD] NORM $
	   ;Place in hardware counter (the "TP TIMER").
	MAPF[TIM.DO] D[MASK 24.] ROT[12.] DEST[Q] C800 $
	D[MEM] ALU[D&Q] DEST[3] DEST-A-MEM NORM JUMP[MAIN] $
	   ;Put other 24 bits into A-MEM[3] (the "TIMER REGISTER").

TDTI:	MAPF[TIM.DI] START-IN D[IOD] ROT[12.] MASK[12.] DEST[AR] C600 $
	   ;Read hardware timer.
	MAPF[TIM.DI] D[IOD] ROT[12.] MASK[12.] DEST[Q] C600 $
	   ;Read it again.
	START-IN D[AR] ALU[D#Q] C550 COND[-OBUS=0] JUMP[TDTI] $
	   ;If it changed, try again (to ensure that we don't get a garbaged
	   ; value because of reading it while it is changing).
	D[13] ALU[DORQ] DEST[AR] NORM POPJ $
	   ;Combine high-order bits from A-MEM[3] with
	   ; low-order bits from hardware counter.

;	IMP,VID,PAN,GRN,DLS,LPT,VC etc.
;------------------------------------------------------------------------------
;
;	Packet Switching Network Interface (IMP)
;
;------------------------------------------------------------------------------
.REPEAT IMP [

	.REPEAT 1 - IMP1 [	;
				;Insert main code body here
	.INSERT IMP.SLO
	] ; 1 - IMP1

	.REPEAT IMP1 [
		;Insert main code body here
	.INSERT IMP1.SLO
	];IMP1

];IMP

;------------------------------------------------------------------------------
;
;	Panofsky-Samson Interface
;
;------------------------------------------------------------------------------
.REPEAT STANSW [

.INSERT PAN.SLO
.INSERT TMPGRN.SLO	;Temporary Grinnell Interface

];.REPEAT STANSW

;------------------------------------------------------------------------------
;
;	Data Line Scanner (TTY scanner)
;
;------------------------------------------------------------------------------
.REPEAT DLS [

.DEFINE ASRC[ X ] [D[10 + X]]
.DEFINE ADEST[ X ] [DEST[X] DEST-A-MEM]

.REPEAT DLS2 [
.INSERT DLS.SLO

.REPEAT DLSDEB [
.INSERT DLSDEB.SLO
];DLSDEB
] ;DLS2
.REPEAT 1 - DLS2 [
.INSERT ODLS.SLO
.REPEAT DLSDEB [
.INSERT ODLSDE.SLO
] ;DLSDEB
] ;1 - DLS2

];DLS			9 JAN 80  BO

;------------------------------------------------------------------------------
;
;	Line Printer Interface (LPT)
;
;------------------------------------------------------------------------------
.REPEAT LPT [

.INSERT LPTX.SLO	

];LPT

;------------------------------------------------------------------------------
;
;	Versatec Interface (VC)
;
;------------------------------------------------------------------------------
.REPEAT VC [

.INSERT VC.SLO

]
; dsk stuff

;a-mem useage:
;	0	dispatch addr for interrupts
;	1	pi chn (33: 35) and intrpt waiting flag (32)
;	2	copy of last cmd sent to controller (by opcode 721)

	.OPCODE[740]	;disk pseudo-iot dispatch table entries.

 ; dcono -- 740
	d[const 10] dest[dev-adr] short $
	d[ir] mask[3] dest[1] DEST-A-MEM norm jump[dcno1]$
; dconi -- 741
	d[const 10] dest[dev-adr] norm pushj[dcni1] $ ;get bits.
	d[ar] dest[memsto] memst $ ;store them and return.
; dconso -- 742
	d[const 10] dest[dev-adr] norm pushj[dcni1] $ ;get bits.
	d[mask 22] alu[d&q] c550 cond[-obus=0] lbjump[dskp1] $
; dconsz -- 743
	d[const 10] dest[dev-adr] norm pushj[dcni1] $ ;get bits.
	d[mask 22] alu[d&q] c550 cond[obus=0] lbjump[dskp1] $

	.RELOC

dcno1:	d[ir] mask[3]  c500 cond[obus=0] jump[main] $
	 ; if assigned pi channel is not 0, then
	 ;  enable interrupt on "not active", by
	 ;  re-loading last cmd with 10 bit on.
	D[CONST 20] DEST[Q] NORM $
	D[IR] ALU[D&Q] C550 OBUS=0 JUMP[DCNO2] $
	D[CONST 40] DEST[Q] NORM JUMP[DCNO3] $
DCNO2:	d[const 10] dest[q] short $
DCNO3:	d[12] alu[dorq] dest[iod] spec[iob-out] norm $
	mapf[4] cylen[iob-out] jump[main] $

dcni1:	d[11] dest[q ar] norm $ ;get intrpt flag and pi chn
	d[ir] alu[d&q] dest[q] norm popj $ ;this is for conso, z

	.ORG[2156]	;$*$*$ 

	;interrupts from disk (dev 10) come here.
	D[CONST 50] ALU[NOTD] DEST[Q] NORM JUMP[DSKINT] $

	.RELOC
	.PAIR
;$*$*$ This exists elsewhere by another name.	TVR-Apr80
dskp1:	jump[main] norm $	;conso and consz lbjump to here.
	doskip $

dskint:	d[12] ALU[D&Q] dest[iod] spec[iob-out] norm  $
	  ;clear interrrupt enable bit (amem[2] has last cmd)
	mapf[4] d[11] dest[q ar] c550 cond[obus=0] jump[ddis] $
	d[const 10] alu[dorq] dest[1] DEST-A-MEM norm
		jump[pigen] $ ;set flag and request intrpt.
ddis:	dest[clr-dev-from-intr] norm jump[main] $

DSKWT1:	D[CONST 10] DEST[DEV-ADR AR] NORM JUMP[DSKWT4] $
DSKWT3:	D[MEM] ROT[31.] C550 COND[OBUS<0] JUMP[DSKWDN] $
	D[CONST 1] ROT[6] LLOAD NORM $
	C550 LOOP[.] $
DSKWT4:	START-IN NORM $
	MAPF[0] D[IOD] DEST[HOLD] C800  JUMP[DSKWT3] $
DSKWDN:	D[AR] ALU[D-1] DEST[AR] C550 COND[-OBUS=0] JUMP[DSKWT4] $
	JUMP[MAIN] $

;
;ECC logging area
;
.REPEAT 1 - XUCODE [
: 7760
];.REPEAT 1 - XUCODE
.REPEAT XUCODE [
: 17760
];.REPEAT XUCODE

 .REPEAT 20 [NOP $
]
;; this should be after everything else
: 0
	JUMP[MSTART] $		;Auto-load micro code tapes someday.